From 3459c3a58f1cdc52fbc916acf306b29408468912 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Tue, 5 Dec 2006 20:31:14 +0000 Subject: [PATCH] merged units branch svn: r5033 --- collects/algol60/bd-tool.ss | 57 +- collects/algol60/tool.ss | 12 +- collects/browser/browser-sig.ss | 60 +- collects/browser/browser-unit.ss | 39 +- collects/browser/browser.ss | 10 +- collects/browser/htmltext.ss | 21 +- collects/browser/private/btree.ss | 16 +- collects/browser/private/bullet.ss | 4 +- collects/browser/private/html.ss | 22 +- collects/browser/private/hyper.ss | 23 +- collects/browser/private/sig.ss | 58 - collects/browser/tool.ss | 6 +- collects/compiler/compiler-unit.ss | 98 +- collects/compiler/compiler.ss | 10 +- collects/compiler/embed-sig.ss | 2 +- collects/compiler/embed-unit.ss | 8 +- collects/compiler/embed.ss | 6 +- collects/compiler/ld-unit.ss | 12 +- collects/compiler/option-unit.ss | 8 +- collects/compiler/option.ss | 6 +- collects/compiler/private/analyze.ss | 12 +- collects/compiler/private/anorm.ss | 13 +- collects/compiler/private/base.ss | 207 +- collects/compiler/private/closure.ss | 13 +- collects/compiler/private/const.ss | 12 +- collects/compiler/private/cstructs.ss | 10 +- collects/compiler/private/driver.ss | 14 +- collects/compiler/private/known.ss | 12 +- collects/compiler/private/library.ss | 10 +- collects/compiler/private/lift.ss | 12 +- collects/compiler/private/prephase.ss | 13 +- collects/compiler/private/rep.ss | 10 +- collects/compiler/private/sig.ss | 17 +- collects/compiler/private/toplevel.ss | 9 +- collects/compiler/private/vehicle.ss | 14 +- collects/compiler/private/vm2c.ss | 13 +- collects/compiler/private/vmopt.ss | 14 +- collects/compiler/private/vmphase.ss | 12 +- collects/compiler/private/vmscheme.ss | 10 +- collects/compiler/private/zlayer.ss | 13 +- collects/compiler/sig.ss | 2 +- collects/drscheme/private/app.ss | 21 +- collects/drscheme/private/debug.ss | 24 +- collects/drscheme/private/drsig.ss | 29 +- collects/drscheme/private/eval.ss | 20 +- collects/drscheme/private/font.ss | 12 +- collects/drscheme/private/frame.ss | 23 +- collects/drscheme/private/get-extend.ss | 21 +- collects/drscheme/private/help-desk.ss | 22 +- collects/drscheme/private/init.ss | 13 +- .../private/language-configuration.ss | 26 +- collects/drscheme/private/language.ss | 18 +- collects/drscheme/private/link.ss | 88 +- collects/drscheme/private/main.ss | 39 +- collects/drscheme/private/modes.ss | 16 +- collects/drscheme/private/module-language.ss | 16 +- collects/drscheme/private/module-overview.ss | 38 +- .../drscheme/private/multi-file-search.ss | 16 +- collects/drscheme/private/rep.ss | 37 +- collects/drscheme/private/teachpack.ss | 10 +- collects/drscheme/private/text.ss | 14 +- collects/drscheme/private/time-keystrokes.ss | 5 +- collects/drscheme/private/tools.ss | 40 +- collects/drscheme/private/unit.ss | 43 +- collects/drscheme/syncheck.ss | 8 +- collects/drscheme/tool-lib.ss | 4 +- collects/dynext/compile-sig.ss | 2 +- collects/dynext/compile-unit.ss | 9 +- collects/dynext/compile.ss | 5 +- collects/dynext/extension-project | Bin 89730 -> 0 bytes collects/dynext/file-sig.ss | 2 +- collects/dynext/file-unit.ss | 8 +- collects/dynext/file.ss | 5 +- collects/dynext/link-sig.ss | 2 +- collects/dynext/link-unit.ss | 8 +- collects/dynext/link.ss | 5 +- collects/dynext/linking-project | Bin 89728 -> 0 bytes collects/eopl/eopl-tool.ss | 6 +- collects/errortrace/errortrace-lib.ss | 5 +- collects/errortrace/stacktrace.ss | 12 +- collects/framework/framework-sig.ss | 64 +- collects/framework/framework-unit.ss | 147 +- collects/framework/framework.ss | 50 +- collects/framework/private/application.ss | 32 +- collects/framework/private/autosave.ss | 36 +- collects/framework/private/canvas.ss | 22 +- collects/framework/private/color-model.ss | 15 +- collects/framework/private/color-prefs.ss | 575 ++-- collects/framework/private/color.ss | 1412 +++++----- collects/framework/private/comment-box.ss | 20 +- collects/framework/private/editor.ss | 40 +- collects/framework/private/exit.ss | 18 +- collects/framework/private/exn.ss | 23 +- collects/framework/private/finder.ss | 19 +- collects/framework/private/frame.ss | 52 +- collects/framework/private/group.ss | 26 +- collects/framework/private/handler.ss | 28 +- collects/framework/private/icon.ss | 16 +- collects/framework/private/keymap.ss | 27 +- collects/framework/private/main.ss | 30 +- collects/framework/private/menu.ss | 16 +- collects/framework/private/mode.ss | 12 +- collects/framework/private/number-snip.ss | 19 +- collects/framework/private/panel.ss | 17 +- collects/framework/private/pasteboard.ss | 23 +- collects/framework/private/path-utils.ss | 14 +- collects/framework/private/preferences.ss | 22 +- collects/framework/private/scheme.ss | 52 +- collects/framework/private/sig.ss | 318 +-- collects/framework/private/text.ss | 31 +- collects/framework/private/version.ss | 23 +- collects/frtime/frtime-tool.ss | 6 +- collects/frtime/graphics-posn-less-unit.ss | 14 +- collects/frtime/graphics-sig.ss | 2 +- collects/frtime/graphics-unit.ss | 19 +- collects/frtime/graphics.ss | 6 +- collects/games/aces/aces.scm | 4 +- collects/games/blackjack/blackjack.ss | 4 +- collects/games/checkers/checkers.ss | 2 +- collects/games/crazy8s/crazy8s.ss | 2 +- collects/games/games.ss | 2 +- collects/games/gcalc/gcalc.ss | 2 +- collects/games/ginrummy/ginrummy.ss | 2 +- collects/games/gobblet/gobblet.ss | 2 +- collects/games/gofish/gofish.ss | 4 +- collects/games/jewel/jewel.scm | 2 +- collects/games/lights-out/lights-out.ss | 4 +- collects/games/memory/memory.ss | 2 +- collects/games/mines/mines.ss | 4 +- .../paint-by-numbers/paint-by-numbers.ss | 2 +- collects/games/parcheesi/parcheesi.ss | 2 +- collects/games/pousse/pousse.ss | 2 +- collects/games/same/same.ss | 2 +- collects/games/slidey/slidey.ss | 2 +- collects/games/spider/spider.ss | 2 +- collects/graphics/graphics-posn-less-unit.ss | 12 +- collects/graphics/graphics-sig.ss | 10 +- collects/graphics/graphics-unit.ss | 20 +- collects/graphics/graphics.ss | 13 +- collects/graphics/turtle-sig.ss | 47 +- collects/graphics/turtle-unit.ss | 16 +- collects/graphics/turtles.ss | 29 +- collects/guibuilder/tool.ss | 6 +- collects/handin-client/client-gui.ss | 5 +- collects/handin-client/handin-multi.ss | 5 +- collects/handin-server/private/coverage.ss | 7 +- collects/handin-server/web-status-server.ss | 21 +- collects/help/private/gui.ss | 16 +- collects/help/private/link.ss | 56 +- collects/help/private/main.ss | 14 +- collects/help/private/sig.ss | 2 +- collects/help/private/tcp-intercept.ss | 16 +- collects/hierlist/hierlist-sig.ss | 23 +- collects/hierlist/hierlist-unit.ss | 13 +- collects/hierlist/hierlist.ss | 23 +- collects/htdch/draw/Canvas-native-methods.ss | 4 +- collects/htdch/draw/World-native-methods.ss | 6 +- collects/htdch/draw/support.scm | 20 +- collects/htdch/idraw/Canvas-native-methods.ss | 4 +- collects/htdch/idraw/World-native-methods.ss | 4 +- collects/htdp/big-draw.ss | 13 +- collects/htdp/draw-sig.ss | 4 +- collects/htdp/draw.ss | 2 +- collects/htdp/graphing.ss | 2 +- collects/htdp/hangman.ss | 2 +- collects/lang/htdp-langs.ss | 14 +- collects/lang/plt-pretty-big-text.ss | 4 +- collects/lang/private/teach.ss | 20 +- collects/lang/private/teachhelp.ss | 6 +- collects/launcher/launcher-sig.ss | 11 +- collects/launcher/launcher-unit.ss | 16 +- collects/launcher/launcher.ss | 8 +- collects/lazy/lazy.ss | 26 +- collects/macro-debugger/tool.ss | 10 +- collects/make/collection-sig.ss | 2 +- collects/make/collection-unit.ss | 14 +- collects/make/collection.ss | 10 +- collects/make/make-sig.ss | 11 +- collects/make/make-unit.ss | 12 +- collects/make/make.ss | 4 +- collects/mred/info.ss | 2 +- collects/mred/mred-sig.ss | 11 +- collects/mred/mred-unit.ss | 6 + collects/mrflow/gui.ss | 6 +- collects/mzlib/a-signature.ss | 29 + collects/mzlib/a-unit.ss | 28 + collects/mzlib/deflate.ss | 2 +- collects/mzlib/pconvert.ss | 10 +- collects/mzlib/private/sigmatch.ss | 2 +- collects/mzlib/private/sigutil.ss | 2 +- collects/mzlib/private/unit-compiletime.ss | 556 ++++ collects/mzlib/private/unit-keywords.ss | 36 + collects/mzlib/private/unit-runtime.ss | 139 + collects/mzlib/private/unit-syntax.ss | 286 ++ collects/mzlib/unit-exptime.ss | 26 + collects/mzlib/unit.ss | 2475 +++++++++++------ collects/mzlib/unit200.ss | 869 ++++++ collects/mzlib/unitsig.ss | 360 +-- collects/mzlib/unitsig200.ss | 359 +++ collects/mzscheme/info.ss | 2 +- collects/mztake/debug-tool.ss | 6 +- collects/mztake/marks.ss | 4 +- collects/net/base64-sig.ss | 18 +- collects/net/base64-unit.ss | 14 +- collects/net/base64.ss | 14 +- collects/net/cgi-sig.ss | 51 +- collects/net/cgi-unit.ss | 13 +- collects/net/cgi.ss | 13 +- collects/net/cookie-sig.ss | 33 +- collects/net/cookie-unit.ss | 547 ++-- collects/net/cookie.ss | 7 +- collects/net/dns-sig.ss | 16 +- collects/net/dns-unit.ss | 22 +- collects/net/dns.ss | 13 +- collects/net/ftp-sig.ss | 19 +- collects/net/ftp-unit.ss | 14 +- collects/net/ftp.ss | 13 +- collects/net/head-sig.ss | 31 +- collects/net/head-unit.ss | 19 +- collects/net/head.ss | 13 +- collects/net/imap-sig.ss | 80 +- collects/net/imap-unit.ss | 14 +- collects/net/imap.ss | 11 +- collects/net/mime-sig.ss | 57 +- collects/net/mime-unit.ss | 13 +- collects/net/mime.ss | 19 +- collects/net/nntp-sig.ss | 40 +- collects/net/nntp-unit.ss | 16 +- collects/net/nntp.ss | 13 +- collects/net/pop3-sig.ss | 46 +- collects/net/pop3-unit.ss | 17 +- collects/net/pop3.ss | 13 +- collects/net/qp-sig.ss | 27 +- collects/net/qp-unit.ss | 11 +- collects/net/qp.ss | 12 +- collects/net/sendmail-sig.ss | 14 +- collects/net/sendmail-unit.ss | 17 +- collects/net/sendmail.ss | 13 +- collects/net/smtp-sig.ss | 15 +- collects/net/smtp-unit.ss | 19 +- collects/net/smtp.ss | 13 +- collects/net/ssl-tcp-unit.ss | 7 +- collects/net/tcp-redirect.ss | 6 +- collects/net/tcp-sig.ss | 10 +- collects/net/tcp-unit.ss | 37 +- collects/net/uri-codec-sig.ss | 24 +- collects/net/uri-codec-unit.ss | 16 +- collects/net/uri-codec.ss | 7 +- collects/net/url-sig.ss | 32 +- collects/net/url-unit.ss | 10 +- collects/net/url.ss | 15 +- collects/profj/tester.scm | 8 +- collects/profj/tool.ss | 9 +- collects/profjBoxes/private/example-box.ss | 10 +- .../profjBoxes/private/interactions-box.ss | 9 +- collects/profjBoxes/tool.ss | 23 +- collects/profjWizard/tool.ss | 6 +- collects/repos-time-stamp/time-stamp.ss | 5 +- collects/setup/doc.txt | 2 +- collects/setup/option-sig.ss | 2 +- collects/setup/option-unit.ss | 8 +- collects/setup/plt-installer-sig.ss | 2 +- collects/setup/plt-installer-unit.ss | 13 +- collects/setup/plt-installer.ss | 9 +- collects/setup/plt-single-installer.ss | 81 +- collects/setup/setup-go.ss | 30 +- collects/setup/setup-unit.ss | 11 +- collects/setup/unpack.ss | 5 +- collects/sirmail/folderr.ss | 12 +- collects/sirmail/optionr.ss | 12 +- collects/sirmail/readr.ss | 20 +- collects/sirmail/sendr.ss | 22 +- collects/sirmail/sirmail.ss | 66 +- collects/sirmail/sirmailr.ss | 49 +- collects/sirmail/sirmails.ss | 20 +- collects/sirmail/utilr.ss | 12 +- collects/skipper/debug-tool.ss | 6 +- collects/skipper/marks.ss | 8 +- collects/slideshow/cmdline.ss | 373 ++- collects/slideshow/code.ss | 7 +- collects/slideshow/core.ss | 14 +- collects/slideshow/param.ss | 12 +- collects/slideshow/sig.ss | 7 +- collects/slideshow/slide.ss | 11 +- collects/slideshow/slides-to-picts.ss | 70 +- collects/slideshow/tool.ss | 6 +- collects/slideshow/viewer.ss | 19 +- collects/stepper/private/annotate.ss | 4 + collects/stepper/private/marks.ss | 3 +- collects/stepper/private/model-settings.ss | 1 + collects/stepper/private/shared.ss | 23 +- collects/stepper/stepper+xml-tool.ss | 13 +- collects/stepper/stepper-tool.ss | 13 +- collects/stepper/xml-sig.ss | 2 + collects/stepper/xml-tool.ss | 12 +- collects/swindle/tool.ss | 4 +- collects/syntax/zodiac-sig.ss | 12 +- collects/syntax/zodiac-unit.ss | 18 +- collects/syntax/zodiac.ss | 5 +- collects/test-suite/private/print-to-text.ss | 10 +- collects/test-suite/private/test-case-box.ss | 26 +- collects/test-suite/private/test-case.ss | 46 +- .../test-suite/private/text-syntax-object.ss | 12 +- collects/test-suite/tool.ss | 24 +- collects/tests/drscheme/tool.ss | 6 +- collects/tests/mzscheme/contmark.ss | 2 +- collects/tests/mzscheme/name.ss | 2 +- collects/tests/mzscheme/pconvert.ss | 12 +- collects/tests/mzscheme/unit.ss | 2 +- collects/tests/mzscheme/unitsig.ss | 4 +- collects/tests/stepper/through-tests.ss | 9 +- collects/tests/units/multi-mod-sigs.ss | 55 + collects/tests/units/test-cert.ss | 39 + collects/tests/units/test-exptime.ss | 43 + collects/tests/units/test-harness.ss | 54 + collects/tests/units/test-runtime.ss | 51 + collects/tests/units/test-unit-compiletime.ss | 331 +++ collects/tests/units/test-unit-syntax.ss | 292 ++ collects/tests/units/test-unit.ss | 1643 +++++++++++ collects/texpict/code.ss | 8 +- collects/texpict/mrpict-sig.ss | 2 +- collects/texpict/mrpict-unit.ss | 21 +- collects/texpict/mrpict.ss | 19 +- collects/texpict/private/common-sig.ss | 2 +- collects/texpict/private/common-unit.ss | 13 +- collects/texpict/private/mrpict-extra.ss | 19 +- collects/texpict/private/mrpict-sig.ss | 2 +- collects/texpict/private/texpict-extra.ss | 17 +- collects/texpict/private/texpict-sig.ss | 2 +- collects/texpict/texpict-sig.ss | 2 +- collects/texpict/texpict-unit.ss | 21 +- collects/texpict/texpict.ss | 11 +- collects/trace/calltrace-lib.ss | 7 +- collects/trace/stacktrace.ss | 12 +- collects/version/tool.ss | 5 +- collects/web-server/configuration.ss | 37 +- .../dispatchers/dispatch-servlets.ss | 9 +- .../private/configuration-structures.ss | 4 +- collects/web-server/private/configuration.ss | 5 +- .../web-server/private/dispatch-server-sig.ss | 2 +- .../private/dispatch-server-unit.ss | 18 +- collects/web-server/sig.ss | 7 +- collects/web-server/tools/servlet-env.ss | 9 +- collects/web-server/web-server-unit.ss | 32 +- collects/web-server/web-server.ss | 26 +- collects/xml/text-box-tool.ss | 6 +- doc/release-notes/mzscheme/HISTORY | 5 + src/mred/wxme/wx_keym.cxx | 2 +- src/mzscheme/dynsrc/start.c | 2 +- src/mzscheme/src/cstartup.inc | 1954 ++++++------- src/mzscheme/src/module.c | 47 +- src/mzscheme/src/schminc.h | 2 +- src/mzscheme/src/schvers.h | 6 +- src/mzscheme/src/stxobj.c | 25 +- src/mzscheme/src/vector.c | 67 +- 355 files changed, 11430 insertions(+), 6949 deletions(-) delete mode 100644 collects/browser/private/sig.ss delete mode 100644 collects/dynext/extension-project delete mode 100644 collects/dynext/linking-project create mode 100644 collects/mred/mred-unit.ss create mode 100644 collects/mzlib/a-signature.ss create mode 100644 collects/mzlib/a-unit.ss create mode 100644 collects/mzlib/private/unit-compiletime.ss create mode 100644 collects/mzlib/private/unit-keywords.ss create mode 100644 collects/mzlib/private/unit-runtime.ss create mode 100644 collects/mzlib/private/unit-syntax.ss create mode 100644 collects/mzlib/unit-exptime.ss create mode 100644 collects/mzlib/unit200.ss create mode 100644 collects/mzlib/unitsig200.ss create mode 100644 collects/stepper/xml-sig.ss create mode 100644 collects/tests/units/multi-mod-sigs.ss create mode 100644 collects/tests/units/test-cert.ss create mode 100644 collects/tests/units/test-exptime.ss create mode 100644 collects/tests/units/test-harness.ss create mode 100644 collects/tests/units/test-runtime.ss create mode 100644 collects/tests/units/test-unit-compiletime.ss create mode 100644 collects/tests/units/test-unit-syntax.ss create mode 100644 collects/tests/units/test-unit.ss diff --git a/collects/algol60/bd-tool.ss b/collects/algol60/bd-tool.ss index e835d5228e..7696ffae0e 100644 --- a/collects/algol60/bd-tool.ss +++ b/collects/algol60/bd-tool.ss @@ -1,22 +1,35 @@ -(module bd-tool mzscheme - (require (lib "encode-decode.ss" "framework" "private")) - (decode 6d54db8e9b3010fd95291512aeea248d7a9156ea457dea733f60251b - 4fc05b63b3b649367fdfb18140225e12983973e676864a62a32d541e - 5f07ed112aa325149d47b50ba1189f0a36996b234248f6d930581d83 - 6ed6a6e89c1943950f758b1d168c7c0a4fda227827e5954b25ae3f09 - 8f11aa4a4115b0765605fe43894825d483f768239fcc8c25026109f8 - 9d8808c23b67630b8ac137b6188934998e237e4a2875c3653786df25 - efc43fe44ebe601d09143bd19750c9411bc57b41e455ed8c21a77676 - 3414c234ce7c3d50a78554bb97be29ee32191da3c1ed64d4e9076a35 - f936f3eed30c2868aab6c1c82f5ac596c167b6e96d51376d4cee5c41 - bdc5cb555d82ec3222c7132c506ca8854138ec8e5ff2cfcaabbcb8f0 - 31784e7680c343f8e47f7f623379efdd592b84b4fa5fcb40f22b5449 - 237b1209cc7a784a0e8e6fbdf3313c43a5bbf474ef7e5e68fa5604fc - 0467a7d583f1f8601c6760f1c2534e7ef2a2c312c2d0a32f0995d53b - bd5256dba2d7314f530e31e6355b34a9db04e1da86286cd459926b45 - 65702258fca3ad4c277013c106b1111d0922c92c53e039b2d515ac37 - a8b430ae29a1f823fafe0abfb58f2d49e923fc4db27a57a4f1a79ad6 - 311d86201aea785a9d7af0cf453e70de28d5aa40c0dbd621b4ee92f3 - 41f53ab8340de9bc42bf12d68489e34184782581cd6085d4212ac616 - fcc66cea56d80679ddd201d2f12fa5a4b9d16720cc733713d1a525d4 - dd91dd0444ec7b7c8b94e969fc5be901363592a7c9d87f)) +(module bd-tool mzscheme + (require (lib "encode-decode.ss" "framework" "private")) + (decode 05c1dd6edc460c06d057f9226301b2e86c5c23690103a9835c + e53a0f50602852d2ecce8f324379adb7ef3924b6a60aeaf6fb + 48dd403909a6d24daf634c984a379d189493609a731ce33ac6 + c4a09c04d351935fc79818949360f2d6f2758c0993f6316f56 + 6c6206a92da91a7a133983683cdf40d91c440a1a36b7aa23fc + abd10d341fbd5bf5306c6e550733332856057d0369740ba555 + dfa08c7f18f40da4d12d683ca18c17666690da92aa41d21aa4 + 806255f4267206d178be814abc5b6872b3d921c94bdc2f2039 + 52d6b047df4073cbd9664fad863dfa8629e6b5e5bf9f27c624 + 7abdedebc4cc0c525b5235e4e49e2d4801c5aae84de40ca2f1 + 7c0365f33f40240554e2dd42939bcd0e495ee27e017d060dab + 0a496b9082d53c3c92fac6f8c2a0cfa0615521690d52b09a87 + cdd2ba39e30b338374069578b7d0e466b3439297b8079d2f90 + c2cca06155a13386791873cc86e7ebcb573c5f5fbe32685855 + e80cedf1112479893b24ad410a9ef1cca06155a133867990e4 + 25ee785a18529819b4f7f69ed4e0ade5ef0c525b52b570d4e4 + f0d6f277502a7beb0eed63deacd8abb796ff63907decad3bb4 + 8f79b362afde5a0ef6b1b7eee33f06a92da91af62d0efb0bef + 2d2983d496540dfb1687bde0bd256590da92aa814abc5ba8f6 + 08474d1e961e8b5d308eddfa8541738e63601cbbf50b28d5cd + 7a72ace6410ef756c31eab65068d63b71e521d1eaba7e80662 + 06a92da91ae4706f1594eaf0583d4537c8e1deea0594937bb6 + 2005b49a0739dc5b0d7bac96199463118d2039dc5b85bd3b83 + b239881454e2dd42939bcd0e4d31b7f582e967dcf7133f52f7 + 4de3f9277e3591f3d384a785994125de2d34b9d9ec2836465c + ed02496b9002655089770b4d6e363be4706ff582e967dcf713 + 3f52f74de3895f4de4fc3441413916d108121883865585626c + ed81a78519f4fb686e20695dad333368585528c6d61e787266 + 66d0f0331be8f7d1dc406ad9dc94999941c3aa8256f320877b + ab618fd53263de625d2dcc5bcadaad82722ca211941934b73a + 20877babc8cccc0c7a6c56d19bc81944e3f906d23ee6cd8abd + aee69fedc3adeaab7db8550d474d1e961e8ba1c4bb856a8f70 + d4e461e9b1d8054f0b33f3ff)) diff --git a/collects/algol60/tool.ss b/collects/algol60/tool.ss index caafc09738..c62a6e9f7c 100644 --- a/collects/algol60/tool.ss +++ b/collects/algol60/tool.ss @@ -1,7 +1,7 @@ (module tool mzscheme (require (lib "tool.ss" "drscheme") (lib "mred.ss" "mred") - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") "parse.ss" "simplify.ss" @@ -16,13 +16,13 @@ 'base-importing-stx)) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) + (export drscheme:tool-exports^) - (define-values/invoke-unit/sig drscheme:tool-exports^ - bd:tool@ - bd - drscheme:tool^) + (define-values/invoke-unit bd:tool@ + (import drscheme:tool^) + (export (prefix bd: drscheme:tool-exports^))) (define (phase1) (bd:phase1)) (define (phase2) diff --git a/collects/browser/browser-sig.ss b/collects/browser/browser-sig.ss index 6b99d9bef3..389d99e3cb 100644 --- a/collects/browser/browser-sig.ss +++ b/collects/browser/browser-sig.ss @@ -1,10 +1,62 @@ (module browser-sig mzscheme - (require (lib "unitsig.ss") - "private/sig.ss") + (require (lib "unit.ss")) - (provide browser^) + (provide relative-btree^ + bullet-export^ + hyper^ + html-export^ + html^) - (define-signature browser^ + (define-signature html-export^ + (html-img-ok + html-eval-ok + image-map-snip%)) + + (define-signature html^ extends html-export^ + (html-convert + html-status-handler)) + + (define-signature bullet-export^ + (bullet-size)) + + (define-signature hyper^ + (open-url + (struct exn:file-saved-instead (pathname)) + (struct exn:cancelled ()) + + hyper-text<%> + hyper-text-mixin + hyper-text% + + hyper-canvas-mixin + hyper-canvas% + + hyper-panel<%> + hyper-panel-mixin + hyper-panel% + + hyper-frame<%> + hyper-frame-mixin + hyper-frame% + + hyper-no-show-frame-mixin + hyper-no-show-frame% + + editor->page + page->editor)) + + (define-signature relative-btree^ + (make-btree + + btree-get + btree-put! + + btree-shift! + + btree-for-each + btree-map)) + + #;(define-signature browser^ ((open hyper^) (open html-export^) (open bullet-export^)))) diff --git a/collects/browser/browser-unit.ss b/collects/browser/browser-unit.ss index 148abdd902..7bf1583c4e 100644 --- a/collects/browser/browser-unit.ss +++ b/collects/browser/browser-unit.ss @@ -1,5 +1,5 @@ (module browser-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") (lib "plt-installer-sig.ss" "setup") (lib "tcp-sig.ss" "net") @@ -8,37 +8,16 @@ "browser-sig.ss" "private/bullet.ss" "private/html.ss" - "private/hyper.ss" - "private/sig.ss") + "private/hyper.ss") (provide browser@) - (define pre-browser@ - (compound-unit/sig - (import (plt-installer : setup:plt-installer^) - (mred : mred^) - (tcp : net:tcp^) - (url : net:url^)) - (link [html : html^ (html@ mred url)] - [hyper : hyper^ (hyper@ html mred plt-installer url)] - [bullet-size : bullet-export^ ((unit/sig bullet-export^ - (import) - (rename (html:bullet-size bullet-size)) - (define html:bullet-size bullet-size)))]) - (export (open hyper) - (open bullet-size) - (open (html : html-export^))))) + (define-unit-from-context bullet@ bullet-export^) + (define-compound-unit/infer browser@ + (import setup:plt-installer^ + mred^ + url^) + (export hyper^ html-export^ bullet-export^) + (link html@ hyper@ bullet@))) - ;; this extra layer of wrapper here is only to - ;; ensure that the browser^ signature actually matches - ;; the export of the pre-browser@ unit. - ;; (it didn't before, so now we check.) - (define browser@ - (compound-unit/sig - (import (plt-installer : setup:plt-installer^) - (mred : mred^) - (tcp : net:tcp^) - (url : net:url^)) - (link [pre-browser : browser^ (pre-browser@ plt-installer mred tcp url)]) - (export (open pre-browser))))) diff --git a/collects/browser/browser.ss b/collects/browser/browser.ss index d90647f9d5..1d5d76658e 100644 --- a/collects/browser/browser.ss +++ b/collects/browser/browser.ss @@ -1,5 +1,5 @@ (module browser mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred.ss" "mred") (lib "mred-sig.ss" "mred") (lib "plt-installer-sig.ss" "setup") @@ -10,10 +10,6 @@ "browser-sig.ss" "browser-unit.ss") - (provide-signature-elements browser^) + (provide-signature-elements hyper^ html-export^ bullet-export^) - (define-values/invoke-unit/sig browser^ browser@ #f - setup:plt-installer^ - mred^ - net:tcp^ - net:url^)) + (define-values/invoke-unit/infer browser@)) diff --git a/collects/browser/htmltext.ss b/collects/browser/htmltext.ss index 9aa0af87b3..c4549dc0b8 100644 --- a/collects/browser/htmltext.ss +++ b/collects/browser/htmltext.ss @@ -1,25 +1,24 @@ (module htmltext mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") - "private/sig.ss" + "browser-sig.ss" "private/html.ss" "private/bullet.ss" (lib "url.ss" "net") (lib "url-sig.ss" "net") (lib "mred.ss" "mred") + (lib "mred-unit.ss" "mred") (lib "mred-sig.ss" "mred") (lib "external.ss" "browser")) - (define-values/invoke-unit/sig - html^ - (compound-unit/sig - (import (MRED : mred^) (URL : net:url^)) - (link [HTML : html^ (html@ MRED URL)]) - (export (open HTML))) - #f - mred^ - net:url^) + (define-unit-from-context url@ url^) + + (define-values/invoke-unit + (compound-unit/infer (import) (export html^) + (link standard-mred@ url@ html@)) + (import) + (export html^)) (define html-text<%> (interface ((class->interface text%)) diff --git a/collects/browser/private/btree.ss b/collects/browser/private/btree.ss index c9bc19e4c6..53f3368180 100644 --- a/collects/browser/private/btree.ss +++ b/collects/browser/private/btree.ss @@ -1,8 +1,5 @@ -(module btree mzscheme - (require "sig.ss" - (lib "unitsig.ss")) - - (provide btree@) +(module btree (lib "a-unit.ss") + (require "../browser-sig.ss") ;; Implements a red-black tree with relative indexing along right ;; splines. This allows the usual O(log(n)) operations, plus a @@ -10,10 +7,9 @@ ;; (This is the same data structure as used for lines by MrEd's text% ;; class, but that one is implemented in C++.) - (define btree@ - (unit/sig relative-btree^ - (import) - (rename (create-btree make-btree)) + (import) + (export (rename relative-btree^ + (create-btree make-btree))) (define-struct btree (root)) @@ -222,4 +218,4 @@ (loop (node-right n) here (+ v (node-pos n)))))) - (cdr start)))))) + (cdr start)))) diff --git a/collects/browser/private/bullet.ss b/collects/browser/private/bullet.ss index 618fa1d99f..351d8220bb 100644 --- a/collects/browser/private/bullet.ss +++ b/collects/browser/private/bullet.ss @@ -1,7 +1,5 @@ (module bullet mzscheme - (require (lib "unitsig.ss") - (lib "mred.ss" "mred") - "sig.ss" + (require (lib "mred.ss" "mred") (lib "class.ss")) (provide bullet-snip% diff --git a/collects/browser/private/html.ss b/collects/browser/private/html.ss index e6f0a5b990..3549e3db34 100644 --- a/collects/browser/private/html.ss +++ b/collects/browser/private/html.ss @@ -1,7 +1,5 @@ - -(module html mzscheme - (require (lib "unitsig.ss") - "sig.ss" +(module html (lib "a-unit.ss") + (require "../browser-sig.ss" (lib "mred-sig.ss" "mred") (lib "file.ss") (lib "etc.ss") @@ -16,14 +14,12 @@ "bullet.ss" "option-snip.ss" "entity-names.ss") - - (provide html@) - - (define html@ - (unit/sig html^ - (import mred^ - net:url^) - + + + (import mred^ url^) + (export html^) + (init-depend mred^) + ;; CACHE (define NUM-CACHED 10) (define cached (make-vector 10 'no-image)) @@ -1262,4 +1258,4 @@ (f)) (send a-text add-tag "top" 0) (update-image-maps image-map-snips image-maps) - (send a-text set-position 0))))))))) + (send a-text set-position 0))))))) diff --git a/collects/browser/private/hyper.ss b/collects/browser/private/hyper.ss index a80aa58065..b003830a0b 100644 --- a/collects/browser/private/hyper.ss +++ b/collects/browser/private/hyper.ss @@ -28,10 +28,8 @@ A test case: #f)) |# -(module hyper mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") - "sig.ss" +(module hyper (lib "a-unit.ss") + (require (lib "class.ss") "../browser-sig.ss" (lib "file.ss") (lib "list.ss") @@ -45,15 +43,14 @@ A test case: (lib "string-constant.ss" "string-constants") (lib "plt-installer-sig.ss" "setup")) - (provide hyper@) - (define hyper@ - (unit/sig hyper^ - (import html^ - mred^ - setup:plt-installer^ - net:url^) - + (import html^ + mred^ + setup:plt-installer^ + url^) + (export hyper^) + (init-depend mred^) + (define-struct (exn:file-saved-instead exn) (pathname)) (define-struct (exn:cancelled exn) ()) (define-struct (exn:tcp-problem exn) ()) @@ -1158,4 +1155,4 @@ A test case: (eq? (car a) (car b))) (define (open-url file) - (make-object hyper-frame% file (string-constant browser) #f 500 450))))) + (make-object hyper-frame% file (string-constant browser) #f 500 450))) diff --git a/collects/browser/private/sig.ss b/collects/browser/private/sig.ss deleted file mode 100644 index 562d4b3bf2..0000000000 --- a/collects/browser/private/sig.ss +++ /dev/null @@ -1,58 +0,0 @@ -(module sig mzscheme - (require (lib "unitsig.ss")) - - (provide relative-btree^ - bullet-export^ - hyper^ - html-export^ - html^) - - (define-signature html-export^ - (html-img-ok - html-eval-ok - image-map-snip%)) - - (define-signature html^ - (html-convert - html-status-handler - (open html-export^))) - - (define-signature bullet-export^ - (bullet-size)) - - (define-signature hyper^ - (open-url - (struct exn:file-saved-instead (pathname)) - (struct exn:cancelled ()) - - hyper-text<%> - hyper-text-mixin - hyper-text% - - hyper-canvas-mixin - hyper-canvas% - - hyper-panel<%> - hyper-panel-mixin - hyper-panel% - - hyper-frame<%> - hyper-frame-mixin - hyper-frame% - - hyper-no-show-frame-mixin - hyper-no-show-frame% - - editor->page - page->editor)) - - (define-signature relative-btree^ - (make-btree - - btree-get - btree-put! - - btree-shift! - - btree-for-each - btree-map))) diff --git a/collects/browser/tool.ss b/collects/browser/tool.ss index 0d724dbe9e..130cf3b603 100644 --- a/collects/browser/tool.ss +++ b/collects/browser/tool.ss @@ -1,14 +1,14 @@ (module tool mzscheme (require (lib "external.ss" "browser") - (lib "unitsig.ss") + (lib "unit.ss") (lib "tool.ss" "drscheme")) (provide tool@) ;; to add a preference pannel to drscheme that sets the browser preference (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define phase1 void) (define phase2 void) diff --git a/collects/compiler/compiler-unit.ss b/collects/compiler/compiler-unit.ss index 75ff3fa8c2..7ec7a37e05 100644 --- a/collects/compiler/compiler-unit.ss +++ b/collects/compiler/compiler-unit.ss @@ -9,10 +9,10 @@ ;; real MrSpidey) or loadr.ss (link in trivial MrSpidey stubs). (module compiler-unit mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") - (require "sig.ss") - (require (lib "file-sig.ss" "dynext") + "sig.ss" + (lib "file-sig.ss" "dynext") (lib "link-sig.ss" "dynext") (lib "compile-sig.ss" "dynext") @@ -20,9 +20,9 @@ (lib "collection-sig.ss" "make") (lib "toplevel.ss" "syntax") - (lib "moddep.ss" "syntax")) + (lib "moddep.ss" "syntax") - (require (lib "list.ss") + (lib "list.ss") (lib "file.ss") (lib "compile.ss") ; gets compile-file (lib "cm.ss") @@ -33,12 +33,12 @@ (define orig-namespace (current-namespace)) ;; ;;;;;;;; ----- The main compiler unit ------ ;;;;;;;;;; - (define compiler@ - (unit/sig compiler^ + (define-unit compiler@ (import compiler:option^ dynext:compile^ dynext:link^ dynext:file^) + (export compiler^) (define compile-notify-handler (make-parameter void)) @@ -60,8 +60,9 @@ (define (make-extension-compiler mode prefix) (let ([u (c-dynamic-require `(lib "base.ss" "compiler" "private") 'base@)] - [init (unit/sig () + [init (unit (import compiler:inner^) + (export) (eval-compile-prefix prefix) (case mode [(compile-extension) compile-extension] @@ -70,22 +71,21 @@ [(compile-extension-part) compile-extension-part] [(compile-extension-part-to-c) compile-extension-part-to-c] [(compile-c-extension-part) compile-c-extension-part]))]) - (invoke-unit/sig - (compound-unit/sig + (invoke-unit + (compound-unit (import (COMPILE : dynext:compile^) (LINK : dynext:link^) (DFILE : dynext:file^) (OPTION : compiler:option^)) - (link [COMPILER : compiler:inner^ (u COMPILE - LINK - DFILE - OPTION)] - [INIT : () (init COMPILER)]) - (export)) - dynext:compile^ - dynext:link^ - dynext:file^ - compiler:option^))) + (export) + (link [((COMPILER : compiler:inner^)) + u + COMPILE LINK DFILE OPTION] + [() init COMPILER])) + (import dynext:compile^ + dynext:link^ + dynext:file^ + compiler:option^)))) (define (make-compiler mode) (lambda (prefix) @@ -119,29 +119,29 @@ (define (link/glue-extension-parts link? compile? source-files destination-directory) (let ([u (c-dynamic-require '(lib "ld-unit.ss" "compiler") 'ld@)] - [init (unit/sig () + [init (unit (import compiler:linker^) + (export) (if link? link-extension (if compile? glue-extension glue-extension-source)))]) - (let ([f (invoke-unit/sig - (compound-unit/sig + (let ([f (invoke-unit + (compound-unit (import (COMPILE : dynext:compile^) (LINK : dynext:link^) (DFILE : dynext:file^) (OPTION : compiler:option^)) - (link [LINKER : compiler:linker^ (u COMPILE - LINK - DFILE - OPTION)] - [INIT : () (init LINKER)]) - (export)) - dynext:compile^ - dynext:link^ - dynext:file^ - compiler:option^)]) + (export) + (link [((LINKER : compiler:linker^)) + u + COMPILE LINK DFILE OPTION] + [() init LINKER])) + (import dynext:compile^ + dynext:link^ + dynext:file^ + compiler:option^))]) (f source-files destination-directory)))) (define (link-extension-parts source-files destination-directory) @@ -195,26 +195,26 @@ (define (compile-directory dir info zos?) (let ([make (c-dynamic-require '(lib "make-unit.ss" "make") 'make@)] [coll (c-dynamic-require '(lib "collection-unit.ss" "make") 'make:collection@)] - [init (unit/sig () - (import make^ make:collection^) + [init (unit + (import make^ make:collection^) + (export) (values make-collection make-notify-handler))]) (let-values ([(make-collection make-notify-handler) - (invoke-unit/sig - (compound-unit/sig + (invoke-unit + (compound-unit (import (DFILE : dynext:file^) (OPTION : compiler:option^) (COMPILER : compiler^)) - (link [MAKE : make^ (make)] - [COLL : make:collection^ (coll MAKE - DFILE - OPTION - COMPILER)] - [INIT : () (init MAKE COLL)]) - (export)) - dynext:file^ - compiler:option^ - compiler^)]) - (let ([orig (current-directory)]) + (export) + (link [((MAKE : make^)) make] + [((COLL : make:collection^)) + coll + MAKE DFILE OPTION COMPILER] + [() init MAKE COLL])) + (import dynext:file^ + compiler:option^ + compiler^))]) + (let ([orig (current-directory)]) (dynamic-wind (lambda () (current-directory dir)) (lambda () @@ -280,4 +280,4 @@ (compile-directory dir info #t)) - ))) + )) diff --git a/collects/compiler/compiler.ss b/collects/compiler/compiler.ss index caf139681c..22972ce9d3 100644 --- a/collects/compiler/compiler.ss +++ b/collects/compiler/compiler.ss @@ -1,6 +1,6 @@ (module compiler mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "sig.ss") @@ -16,13 +16,7 @@ (require "compiler-unit.ss") - (define-values/invoke-unit/sig compiler^ - compiler@ - #f - compiler:option^ - dynext:compile^ - dynext:link^ - dynext:file^) + (define-values/invoke-unit/infer compiler@) (provide-signature-elements compiler^)) diff --git a/collects/compiler/embed-sig.ss b/collects/compiler/embed-sig.ss index b177327dbd..dede40321b 100644 --- a/collects/compiler/embed-sig.ss +++ b/collects/compiler/embed-sig.ss @@ -1,6 +1,6 @@ (module embed-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide compiler:embed^) (define-signature compiler:embed^ diff --git a/collects/compiler/embed-unit.ss b/collects/compiler/embed-unit.ss index 63bb497738..5724c29c30 100644 --- a/collects/compiler/embed-unit.ss +++ b/collects/compiler/embed-unit.ss @@ -1,6 +1,6 @@ (module embed-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "file.ss") (lib "list.ss") (lib "etc.ss") @@ -19,9 +19,9 @@ (provide compiler:embed@) - (define compiler:embed@ - (unit/sig compiler:embed^ + (define-unit compiler:embed@ (import) + (export compiler:embed^) (define (embedding-executable-is-directory? mred?) #f) @@ -846,5 +846,5 @@ [(not p) #f] [(list? p) (map mac-mred-collects-path-adjust p)] [(relative-path? p) (build-path 'up 'up 'up p)] - [else p]))))) + [else p])))) diff --git a/collects/compiler/embed.ss b/collects/compiler/embed.ss index 01aa336c7e..ac613f7bb0 100644 --- a/collects/compiler/embed.ss +++ b/collects/compiler/embed.ss @@ -1,6 +1,6 @@ (module embed mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "contract.ss")) (require "sig.ss") @@ -8,9 +8,7 @@ (require "embed-unit.ss" "embed-sig.ss") - (define-values/invoke-unit/sig compiler:embed^ - compiler:embed@ - #f) + (define-values/invoke-unit/infer compiler:embed@) (provide/contract [make-embedding-executable (opt-> (path-string? diff --git a/collects/compiler/ld-unit.ss b/collects/compiler/ld-unit.ss index d9f97cfb79..4e0016530f 100644 --- a/collects/compiler/ld-unit.ss +++ b/collects/compiler/ld-unit.ss @@ -1,6 +1,6 @@ (module ld-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss")) (require "sig.ss") @@ -11,13 +11,13 @@ (provide ld@) - (define ld@ - (unit/sig compiler:linker^ + (define-unit ld@ (import dynext:compile^ dynext:link^ dynext:file^ - (compiler:option : compiler:option^)) - (rename (link-extension* link-extension)) + (prefix compiler:option: compiler:option^)) + (export (rename compiler:linker^ + [link-extension* link-extension])) ;; Copied from library.ss; please fix me! @@ -308,4 +308,4 @@ (delete-file (build-path dest-dir _loader.o))) (printf " [output to \"~a\"]~n" (build-path dest-dir _loader.so))) - (printf " [output to \"~a\"]~n" (build-path dest-dir _loader.o))))))))) + (printf " [output to \"~a\"]~n" (build-path dest-dir _loader.o)))))))) diff --git a/collects/compiler/option-unit.ss b/collects/compiler/option-unit.ss index 4644d6916d..900cee34f7 100644 --- a/collects/compiler/option-unit.ss +++ b/collects/compiler/option-unit.ss @@ -1,14 +1,14 @@ (module option-unit mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "sig.ss") (provide compiler:option@) - (define compiler:option@ - (unit/sig compiler:option^ + (define-unit compiler:option@ (import) + (export compiler:option^) (define propagate-constants (make-parameter #t)) (define assume-primitives (make-parameter #f)) @@ -39,4 +39,4 @@ (define compile-for-embedded (make-parameter #f)) ;; Maybe #f helps for register-poor architectures? - (define unpack-environments (make-parameter #f))))) + (define unpack-environments (make-parameter #f)))) diff --git a/collects/compiler/option.ss b/collects/compiler/option.ss index e5eee5de12..0526d54390 100644 --- a/collects/compiler/option.ss +++ b/collects/compiler/option.ss @@ -1,12 +1,10 @@ (module option mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "sig.ss") (require "option-unit.ss") - (define-values/invoke-unit/sig - compiler:option^ - compiler:option@) + (define-values/invoke-unit/infer compiler:option@) (provide-signature-elements compiler:option^)) diff --git a/collects/compiler/private/analyze.ss b/collects/compiler/private/analyze.ss index f1ef80f216..1e651a6b95 100644 --- a/collects/compiler/private/analyze.ss +++ b/collects/compiler/private/analyze.ss @@ -39,7 +39,7 @@ ;;; ------------------------------------------------------------ (module analyze mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -49,12 +49,11 @@ (require "../sig.ss") (provide analyze@) - (define analyze@ - (unit/sig compiler:analyze^ - (import (compiler:option : compiler:option^) + (define-unit analyze@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:prephase^ compiler:anorm^ @@ -63,6 +62,7 @@ compiler:rep^ compiler:vm2c^ compiler:driver^) + (export compiler:analyze^) (define-struct mod-glob (cname ;; a made-up name that encodes module + var modname @@ -1385,4 +1385,4 @@ captured-vars codes max-arity - multi))))))))) + multi)))))))) diff --git a/collects/compiler/private/anorm.ss b/collects/compiler/private/anorm.ss index 4cd6408c08..d8e58de373 100644 --- a/collects/compiler/private/anorm.ss +++ b/collects/compiler/private/anorm.ss @@ -30,7 +30,7 @@ ;;; ------------------------------------------------------------ (module anorm mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -40,15 +40,14 @@ (require "../sig.ss") (provide anorm@) - (define anorm@ - (unit/sig - compiler:anorm^ - (import (compiler:option : compiler:option^) + (define-unit anorm@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:driver^) + (export compiler:anorm^) (define compiler:a-value? (one-of zodiac:quote-form? zodiac:varref? zodiac:quote-syntax-form?)) @@ -369,4 +368,4 @@ (k wcm))))))] [else (error 'a-normalize "unsupported ~a" ast)]))]) - a-normalize))))) + a-normalize)))) diff --git a/collects/compiler/private/base.ss b/collects/compiler/private/base.ss index 2c51b15b3e..0eae068e5e 100644 --- a/collects/compiler/private/base.ss +++ b/collects/compiler/private/base.ss @@ -1,6 +1,6 @@ (module base mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "../sig.ss") (require "sig.ss") @@ -36,182 +36,29 @@ (provide base@) - (define base@ - (compound-unit/sig - (import (COMPILE : dynext:compile^) - (LINK : dynext:link^) - (DFILE : dynext:file^) - (OPTIONS : compiler:option^)) - (link - [ZODIAC : zodiac^ (zodiac@)] - [ZLAYER : compiler:zlayer^ (zlayer@ - OPTIONS - ZODIAC - CSTRUCTS - DRIVER)] - [LIBRARY : compiler:library^ (library@ - ZODIAC)] - [CSTRUCTS : compiler:cstructs^ (cstructs@ - LIBRARY - ZODIAC - ZLAYER)] - [PREPHASE : compiler:prephase^ (prephase@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - DRIVER)] - [ANORM : compiler:anorm^ (anorm@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - DRIVER)] - [CONST : compiler:const^ (const@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ANALYZE - ZLAYER - VMSTRUCTS - TOP-LEVEL - DRIVER)] - [KNOWN : compiler:known^ (known@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - PREPHASE - ANORM - CONST - CLOSURE - REP - DRIVER)] - [ANALYZE : compiler:analyze^ (analyze@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - PREPHASE - ANORM - KNOWN - CONST - REP - VM2C - DRIVER)] - [LIFT : compiler:lift^ (lift@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - KNOWN - TOP-LEVEL - ANALYZE - CONST - CLOSURE - DRIVER)] - [CLOSURE : compiler:closure^ (closure@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - CONST - DRIVER)] - [VEHICLE : compiler:vehicle^ (vehicle@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - CONST - KNOWN - CLOSURE - DRIVER)] - [REP : compiler:rep^ (rep@ - LIBRARY - CSTRUCTS - ANALYZE - ZODIAC - ZLAYER - CONST - VEHICLE - DRIVER)] - [VMSTRUCTS : compiler:vmstructs^ (vmscheme@ - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - DRIVER)] - [VMPHASE : compiler:vmphase^ (vmphase@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - ANALYZE - CONST - VMSTRUCTS - REP - CLOSURE - VEHICLE - DRIVER)] - [VMOPT : compiler:vmopt^ (vmopt@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - VMSTRUCTS - KNOWN - REP - VMPHASE - DRIVER)] - [VM2C : compiler:vm2c^ (vm2c@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - ANALYZE - CONST - REP - CLOSURE - VEHICLE - VMSTRUCTS - DRIVER)] - [TOP-LEVEL : compiler:top-level^ (toplevel@ - LIBRARY - CSTRUCTS)] - [DRIVER : compiler:driver^ (driver@ - OPTIONS - LIBRARY - CSTRUCTS - ZODIAC - ZLAYER - PREPHASE - ANORM - KNOWN - ANALYZE - CONST - LIFT - CLOSURE - VEHICLE - REP - VMSTRUCTS - VMPHASE - VMOPT - VM2C - TOP-LEVEL - COMPILE - LINK - DFILE)]) - (export (open (DRIVER : compiler:inner^)))))) - - + (define-compound-unit/infer base@ + (import (COMPILE : dynext:compile^) + (LINK : dynext:link^) + (DFILE : dynext:file^) + (OPTIONS : compiler:option^)) + (export compiler:inner^) + (link + zodiac@ + zlayer@ + library@ + cstructs@ + prephase@ + anorm@ + const@ + known@ + analyze@ + lift@ + closure@ + vehicle@ + rep@ + vmscheme@ + vmphase@ + vmopt@ + vm2c@ + toplevel@ + driver@))) diff --git a/collects/compiler/private/closure.ss b/collects/compiler/private/closure.ss index e0a6e070c3..3a35182db2 100644 --- a/collects/compiler/private/closure.ss +++ b/collects/compiler/private/closure.ss @@ -17,7 +17,7 @@ ;;; ------------------------------------------------------------ (module closure mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -27,16 +27,15 @@ (require "../sig.ss") (provide closure@) - (define closure@ - (unit/sig - compiler:closure^ - (import (compiler:option : compiler:option^) + (define-unit closure@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:const^ compiler:driver^) + (export compiler:closure^) (define compiler:closure-list null) (define compiler:add-closure! @@ -281,4 +280,4 @@ ast (format "closure-expression: form not supported: ~a" ast))]))]) - (lambda (ast) (transform! ast))))))) + (lambda (ast) (transform! ast)))))) diff --git a/collects/compiler/private/const.ss b/collects/compiler/private/const.ss index f7c3470555..11c4f7e8c8 100644 --- a/collects/compiler/private/const.ss +++ b/collects/compiler/private/const.ss @@ -11,7 +11,7 @@ ; that is prefixed onto the beginning of the program. (module const mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -22,17 +22,17 @@ (require "../sig.ss") (provide const@) - (define const@ - (unit/sig compiler:const^ - (import (compiler:option : compiler:option^) + (define-unit const@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:analyze^ compiler:zlayer^ compiler:vmstructs^ compiler:top-level^ compiler:driver^) + (export compiler:const^) (define const:symbol-table (make-hash-table)) (define const:symbol-counter 0) @@ -432,5 +432,5 @@ (bytes? (zodiac:zread-object ast))) (const:intern-string (zodiac:zread-object ast))) (compiler:add-const! (compiler:re-quote ast) - varref:static)])))))) + varref:static)]))))) diff --git a/collects/compiler/private/cstructs.ss b/collects/compiler/private/cstructs.ss index 40b03d7d0e..fc88e53240 100644 --- a/collects/compiler/private/cstructs.ss +++ b/collects/compiler/private/cstructs.ss @@ -5,7 +5,7 @@ ;; Mostly structure definitions, mostly for annotations. (module cstructs mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -15,11 +15,11 @@ (require "../sig.ss") (provide cstructs@) - (define cstructs@ - (unit/sig compiler:cstructs^ + (define-unit cstructs@ (import compiler:library^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^) + (export compiler:cstructs^) ;;---------------------------------------------------------------------------- ;; VARREF ATTRIBUTES @@ -226,4 +226,4 @@ (define-struct (compiler:error-msg compiler:message) ()) (define-struct (compiler:fatal-error-msg compiler:message) ()) (define-struct (compiler:internal-error-msg compiler:message) ()) - (define-struct (compiler:warning-msg compiler:message) ())))) + (define-struct (compiler:warning-msg compiler:message) ()))) diff --git a/collects/compiler/private/driver.ss b/collects/compiler/private/driver.ss index b9e026adbd..fb16a967c0 100644 --- a/collects/compiler/private/driver.ss +++ b/collects/compiler/private/driver.ss @@ -60,7 +60,7 @@ ;; the binding. (module driver mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "file.ss") (lib "port.ss") @@ -82,12 +82,11 @@ (provide driver@) - (define driver@ - (unit/sig compiler:driver^ - (import (compiler:option : compiler:option^) + (define-unit driver@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:prephase^ compiler:anorm^ @@ -106,7 +105,8 @@ dynext:compile^ dynext:link^ dynext:file^) - (rename (compile-extension* compile-extension)) + (export (rename compiler:driver^ + [compile-extension* compile-extension])) (define debug:file "dump.txt") (define debug:port #f) @@ -1433,4 +1433,4 @@ (when (compiler:option:verbose) (printf " finished [cpu ~a, real ~a].~n" total-cpu-time - total-real-time)))))))) + total-real-time))))))) diff --git a/collects/compiler/private/known.ss b/collects/compiler/private/known.ss index 27d4acfbd8..6991aff0f2 100644 --- a/collects/compiler/private/known.ss +++ b/collects/compiler/private/known.ss @@ -21,7 +21,7 @@ ;;; ------------------------------------------------------------ (module known mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -31,12 +31,11 @@ (require "../sig.ss") (provide known@) - (define known@ - (unit/sig compiler:known^ - (import (compiler:option : compiler:option^) + (define-unit known@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:prephase^ compiler:anorm^ @@ -44,6 +43,7 @@ compiler:closure^ compiler:rep^ compiler:driver^) + (export compiler:known^) ;; helper functions to create a binding annotation (define make-known-binding @@ -584,4 +584,4 @@ ast)))]))]) (lambda (ast) - (analyze! ast))))))) + (analyze! ast)))))) diff --git a/collects/compiler/private/library.ss b/collects/compiler/private/library.ss index 492fe2b653..277f4a2add 100644 --- a/collects/compiler/private/library.ss +++ b/collects/compiler/private/library.ss @@ -3,7 +3,7 @@ ;; (c) 1997-8 PLT, Rice University (module library mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -12,9 +12,9 @@ (require "sig.ss") (provide library@) - (define library@ - (unit/sig compiler:library^ - (import (zodiac : zodiac^)) + (define-unit library@ + (import (prefix zodiac: zodiac^)) + (export compiler:library^) (define logical-inverse (lambda (fun) @@ -332,4 +332,4 @@ " ")) (define (global-defined-value* v) - (and v (namespace-variable-value v)))))) + (and v (namespace-variable-value v))))) diff --git a/collects/compiler/private/lift.ss b/collects/compiler/private/lift.ss index 501b577fe0..8910f92535 100644 --- a/collects/compiler/private/lift.ss +++ b/collects/compiler/private/lift.ss @@ -21,7 +21,7 @@ ;;; ------------------------------------------------------------ (module lift mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -31,12 +31,11 @@ (require "../sig.ss") (provide lift@) - (define lift@ - (unit/sig compiler:lift^ - (import (compiler:option : compiler:option^) + (define-unit lift@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:known^ compiler:top-level^ @@ -44,6 +43,7 @@ compiler:const^ compiler:closure^ compiler:driver^) + (export compiler:lift^) (define lifting-allowed? #t) (define mutual-lifting-allowed? #t) @@ -618,4 +618,4 @@ (set! globals empty-set) (let ([ast (lift! ast code)]) - (cons ast globals)))))))) + (cons ast globals))))))) diff --git a/collects/compiler/private/prephase.ss b/collects/compiler/private/prephase.ss index a993a94017..3874429c2d 100644 --- a/collects/compiler/private/prephase.ss +++ b/collects/compiler/private/prephase.ss @@ -40,7 +40,7 @@ ;;; ------------------------------------------------------------ (module prephase mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "zodiac-sig.ss" "syntax")) @@ -48,15 +48,14 @@ (require "../sig.ss") (provide prephase@) - (define prephase@ - (unit/sig - compiler:prephase^ - (import (compiler:option : compiler:option^) + (define-unit prephase@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:driver^) + (export compiler:prephase^) (define-struct binding-properties (mutable? unit-i/e? ivar? anchor known-val)) @@ -687,4 +686,4 @@ ast (format "unsupported syntactic form ~a" ast)) ast]))]) - prephase!))))) + prephase!)))) diff --git a/collects/compiler/private/rep.ss b/collects/compiler/private/rep.ss index d943250971..92dc497824 100644 --- a/collects/compiler/private/rep.ss +++ b/collects/compiler/private/rep.ss @@ -15,7 +15,7 @@ ;;; ------------------------------------------------------------ (module rep mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "zodiac-sig.ss" "syntax")) @@ -23,16 +23,16 @@ (require "../sig.ss") (provide rep@) - (define rep@ - (unit/sig compiler:rep^ + (define-unit rep@ (import compiler:library^ compiler:cstructs^ compiler:analyze^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:const^ compiler:vehicle^ compiler:driver^) + (export compiler:rep^) ;;---------------------------------------------------------------------------- ;; REPRESENTATION (TYPE) LANGUAGE @@ -230,4 +230,4 @@ (set-closure-code-rep! code struct) (set-closure-code-alloc-rep! code alloc-struct))))) - ))) + )) diff --git a/collects/compiler/private/sig.ss b/collects/compiler/private/sig.ss index 5953111806..8b0eed441f 100644 --- a/collects/compiler/private/sig.ss +++ b/collects/compiler/private/sig.ss @@ -1,6 +1,6 @@ (module sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "../sig.ss") (require (lib "zodiac-sig.ss" "syntax")) @@ -358,10 +358,8 @@ (vm-optimize!)) (provide compiler:driver^) - (define-signature compiler:driver^ - ((open compiler:inner^) - - compiler:error + (define-signature compiler:driver^ extends compiler:inner^ + (compiler:error compiler:fatal-error compiler:internal-error compiler:warning @@ -420,11 +418,4 @@ vm->c:emit-case-prologue vm->c:emit-case-epilogue vm->c:emit-function-epilogue - vm->c-expression)) - - (provide compiler:basic-link^) - (define-signature compiler:basic-link^ - ((unit ZODIAC : zodiac^) - (unit ZLAYER : compiler:zlayer^) - (unit DRIVER : compiler:driver^) - (unit LIBRARY : compiler:library^)))) + vm->c-expression))) diff --git a/collects/compiler/private/toplevel.ss b/collects/compiler/private/toplevel.ss index ca334ac0c2..8d35ced397 100644 --- a/collects/compiler/private/toplevel.ss +++ b/collects/compiler/private/toplevel.ss @@ -3,16 +3,15 @@ ;; (c) 1997-2001 PLT (module toplevel mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "sig.ss") (provide toplevel@) - (define toplevel@ - (unit/sig - compiler:top-level^ + (define-unit toplevel@ (import compiler:library^ compiler:cstructs^) + (export compiler:top-level^) ;;------------------------------------------------------------- ;; This contains information about a top-level block, either at @@ -82,5 +81,5 @@ ;; remove-code-captured-vars - parent handling is the same ;; as remove-code-free-vars - ))) + )) diff --git a/collects/compiler/private/vehicle.ss b/collects/compiler/private/vehicle.ss index 2f2f32950f..e8dd4f1237 100644 --- a/collects/compiler/private/vehicle.ss +++ b/collects/compiler/private/vehicle.ss @@ -20,7 +20,7 @@ ;;; ------------------------------------------------------------ (module vehicle mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "zodiac-sig.ss" "syntax")) @@ -28,18 +28,18 @@ (require "../sig.ss") (provide vehicle@) - (define vehicle@ - (unit/sig - compiler:vehicle^ - (import (compiler:option : compiler:option^) + (define-unit vehicle@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:const^ compiler:known^ compiler:closure^ compiler:driver^) + (export compiler:vehicle^) + ;; Used for union-find for lambda vehicles: (define (get-vehicle-top code) @@ -241,5 +241,5 @@ (lambda (current-lambda ast) (relate! current-lambda ast)))) (define (vehicle:only-code-in-vehicle? code) - (= (vehicle-total-labels (get-vehicle (closure-code-vehicle code))) 1))))) + (= (vehicle-total-labels (get-vehicle (closure-code-vehicle code))) 1)))) diff --git a/collects/compiler/private/vm2c.ss b/collects/compiler/private/vm2c.ss index 3ffaaa3e10..941dcc25a8 100644 --- a/collects/compiler/private/vm2c.ss +++ b/collects/compiler/private/vm2c.ss @@ -3,7 +3,7 @@ ;; (c) 1997-2001 PLT (module vm2c mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss")) (require (lib "zodiac-sig.ss" "syntax") @@ -13,13 +13,11 @@ (require "../sig.ss") (provide vm2c@) - (define vm2c@ - (unit/sig - compiler:vm2c^ - (import (compiler:option : compiler:option^) + (define-unit vm2c@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:analyze^ compiler:const^ @@ -28,6 +26,7 @@ compiler:vehicle^ compiler:vmstructs^ compiler:driver^) + (export compiler:vm2c^) (define local-vars-at-top? #f) @@ -1581,4 +1580,4 @@ ast (format "vm:build-constant: not supported ~a" ast))]))] - [else (compiler:internal-error #f (format "vm2c: ~a not supported" ast))])))))))) + [else (compiler:internal-error #f (format "vm2c: ~a not supported" ast))]))))))) diff --git a/collects/compiler/private/vmopt.ss b/collects/compiler/private/vmopt.ss index 4111c4073a..203e621f0b 100644 --- a/collects/compiler/private/vmopt.ss +++ b/collects/compiler/private/vmopt.ss @@ -8,7 +8,7 @@ (module vmopt mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -18,19 +18,19 @@ (require "../sig.ss") (provide vmopt@) - (define vmopt@ - (unit/sig - compiler:vmopt^ - (import (compiler:option : compiler:option^) + (define-unit vmopt@ + + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:vmstructs^ compiler:known^ compiler:rep^ compiler:vmphase^ compiler:driver^) + (export compiler:vmopt^) (define satisfies-arity? (lambda (arity L arglist) @@ -583,4 +583,4 @@ (set! new-locs empty-set) (values (process! ast) - new-locs)))))))) + new-locs))))))) diff --git a/collects/compiler/private/vmphase.ss b/collects/compiler/private/vmphase.ss index a94341bbd1..0e9147f17d 100644 --- a/collects/compiler/private/vmphase.ss +++ b/collects/compiler/private/vmphase.ss @@ -10,7 +10,7 @@ ;; to macro uses (where the macros are defined in mzc.h). (module vmphase mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -21,12 +21,11 @@ "../sig.ss") (provide vmphase@) - (define vmphase@ - (unit/sig compiler:vmphase^ - (import (compiler:option : compiler:option^) + (define-unit vmphase@ + (import (prefix compiler:option: compiler:option^) compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:analyze^ compiler:const^ @@ -35,6 +34,7 @@ compiler:closure^ compiler:vehicle^ compiler:driver^) + (export compiler:vmphase^) ;; vm:convert-bound-varref takes a bound-varref and turns it ;; into a vm:local-varref, taking into account its representation. @@ -1006,4 +1006,4 @@ (zodiac:zodiac-stx ast) (convert ast multi? (or leaf list) tail-pos tail? (not tail?))) - new-locals))))))) + new-locals)))))) diff --git a/collects/compiler/private/vmscheme.ss b/collects/compiler/private/vmscheme.ss index f418ea60e2..a31749f9e5 100644 --- a/collects/compiler/private/vmscheme.ss +++ b/collects/compiler/private/vmscheme.ss @@ -6,7 +6,7 @@ (module vmscheme mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -16,13 +16,13 @@ (require "../sig.ss") (provide vmscheme@) - (define vmscheme@ - (unit/sig compiler:vmstructs^ + (define-unit vmscheme@ (import compiler:library^ compiler:cstructs^ - (zodiac : zodiac^) + (prefix zodiac: zodiac^) compiler:zlayer^ compiler:driver^) + (export compiler:vmstructs^) ;; Block statements (define-struct (vm:sequence zodiac:zodiac) (vals)) @@ -131,7 +131,7 @@ void? undefined?)]) (lambda (i) - (p? (syntax-e (zodiac:zodiac-stx i))))))))) + (p? (syntax-e (zodiac:zodiac-stx i)))))))) #| diff --git a/collects/compiler/private/zlayer.ss b/collects/compiler/private/zlayer.ss index 8fd006653d..023d325f2e 100644 --- a/collects/compiler/private/zlayer.ss +++ b/collects/compiler/private/zlayer.ss @@ -3,7 +3,7 @@ ;; (c)1997-2001 PLT (module zlayer mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "etc.ss")) @@ -13,12 +13,12 @@ (require "sig.ss") (provide zlayer@) - (define zlayer@ - (unit/sig compiler:zlayer^ - (import (compiler:option : compiler:option^) - (zodiac : zodiac^) + (define-unit zlayer@ + (import (prefix compiler:option: compiler:option^) + (prefix zodiac: zodiac^) compiler:cstructs^ compiler:driver^) + (export compiler:zlayer^) ;;---------------------------------------------------------------------------- ;; ANNOTATIONS @@ -245,5 +245,4 @@ `(module ... ,(zodiac->sexp/annotate (zodiac:module-form-body ast)))] [else - (error 'zodiac->sexp/annotate "unsupported ~s" ast)])))))) - + (error 'zodiac->sexp/annotate "unsupported ~s" ast)]))))) diff --git a/collects/compiler/sig.ss b/collects/compiler/sig.ss index 16729ae628..584e5821a9 100644 --- a/collects/compiler/sig.ss +++ b/collects/compiler/sig.ss @@ -1,7 +1,7 @@ (module sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide compiler:option^ compiler^ diff --git a/collects/drscheme/private/app.ss b/collects/drscheme/private/app.ss index 58d5af5485..b84260f0d5 100644 --- a/collects/drscheme/private/app.ss +++ b/collects/drscheme/private/app.ss @@ -1,7 +1,6 @@ -(module app mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module app (lib "a-unit.ss") + (require (lib "class.ss") (lib "list.ss") (lib "file.ss") (lib "string-constant.ss" "string-constants") @@ -12,14 +11,12 @@ "drsig.ss" "../acks.ss") - (provide app@) - (define app@ - (unit/sig drscheme:app^ - (import [drscheme:unit : drscheme:unit^] - [drscheme:frame : drscheme:frame^] - [drscheme:language-configuration : drscheme:language-configuration/internal^] - [help-desk : drscheme:help-desk^] - [drscheme:tools : drscheme:tools^]) + (import [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix help-desk: drscheme:help-desk^] + [prefix drscheme:tools: drscheme:tools^]) + (export drscheme:app^) (define about-frame% (class (drscheme:frame:basics-mixin (frame:standard-menus-mixin frame:basic%)) @@ -503,4 +500,4 @@ (cdr strs) (cons lang good-langs) (cons str good-strs)) - (loop (cdr langs) (cdr strs) good-langs good-strs)))])))))) + (loop (cdr langs) (cdr strs) good-langs good-strs)))])))) diff --git a/collects/drscheme/private/debug.ss b/collects/drscheme/private/debug.ss index 116866e48e..668491eb0e 100644 --- a/collects/drscheme/private/debug.ss +++ b/collects/drscheme/private/debug.ss @@ -7,7 +7,7 @@ profile todo: |# (module debug mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "stacktrace.ss" "errortrace") (lib "class.ss") (lib "list.ss") @@ -23,14 +23,15 @@ profile todo: (define orig (current-output-port)) (provide debug@) - (define debug@ - (unit/sig drscheme:debug^ - (import [drscheme:rep : drscheme:rep^] - [drscheme:frame : drscheme:frame^] - [drscheme:unit : drscheme:unit^] - [drscheme:language : drscheme:language^] - [drscheme:language-configuration : drscheme:language-configuration/internal^] - [drscheme:init : drscheme:init^]) + (define-unit debug@ + (import [prefix drscheme:rep: drscheme:rep^] + [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:language: drscheme:language^] + [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix drscheme:init: drscheme:init^]) + (export drscheme:debug^) + (define (oprintf . args) (apply fprintf orig args)) @@ -1931,6 +1932,5 @@ profile todo: ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;; ;;;; ;;;; ;;; ;;;; ;;; ;;;; ;;; ; ;;; ;;; - - - (define-values/invoke-unit/sig stacktrace^ stacktrace@ #f stacktrace-imports^)))) + + (define-values/invoke-unit/infer stacktrace@))) diff --git a/collects/drscheme/private/drsig.ss b/collects/drscheme/private/drsig.ss index 2ecaac814e..520424a3ee 100644 --- a/collects/drscheme/private/drsig.ss +++ b/collects/drscheme/private/drsig.ss @@ -1,6 +1,6 @@ (module drsig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide drscheme:eval^ drscheme:debug^ @@ -35,7 +35,7 @@ add-initial-modes (struct mode (name surrogate repl-submit matches-language) -setters - (- make-mode)))) + -constructor))) (define-signature drscheme:font^ (setup-preferences)) @@ -97,10 +97,9 @@ language-dialog fill-language-dialog)) - (define-signature drscheme:language-configuration/internal^ + (define-signature drscheme:language-configuration/internal^ extends drscheme:language-configuration^ (add-info-specified-languages get-default-language-settings - (open drscheme:language-configuration^) settings-preferences-symbol add-built-in-languages @@ -269,14 +268,14 @@ phase2)) (define-signature drscheme:tool^ - ((unit drscheme:debug : drscheme:debug^) - (unit drscheme:unit : drscheme:unit^) - (unit drscheme:rep : drscheme:rep^) - (unit drscheme:frame : drscheme:frame^) - (unit drscheme:get/extend : drscheme:get/extend^) - (unit drscheme:language-configuration : drscheme:language-configuration^) - (unit drscheme:language : drscheme:language^) - (unit drscheme:help-desk : drscheme:help-desk^) - (unit drscheme:eval : drscheme:eval^) - (unit drscheme:teachpack : drscheme:teachpack^) - (unit drscheme:modes : drscheme:modes^)))) + ((open (prefix drscheme:debug: drscheme:debug^)) + (open (prefix drscheme:unit: drscheme:unit^)) + (open (prefix drscheme:rep: drscheme:rep^)) + (open (prefix drscheme:frame: drscheme:frame^)) + (open (prefix drscheme:get/extend: drscheme:get/extend^)) + (open (prefix drscheme:language-configuration: drscheme:language-configuration^)) + (open (prefix drscheme:language: drscheme:language^)) + (open (prefix drscheme:help-desk: drscheme:help-desk^)) + (open (prefix drscheme:eval: drscheme:eval^)) + (open (prefix drscheme:teachpack: drscheme:teachpack^)) + (open (prefix drscheme:modes: drscheme:modes^))))) diff --git a/collects/drscheme/private/eval.ss b/collects/drscheme/private/eval.ss index 0da86983b2..1ccafbb849 100644 --- a/collects/drscheme/private/eval.ss +++ b/collects/drscheme/private/eval.ss @@ -1,7 +1,7 @@ (module eval mzscheme (require (lib "mred.ss" "mred") - (lib "unitsig.ss") + (lib "unit.ss") (lib "port.ss") (lib "class.ss") (lib "toplevel.ss" "syntax") @@ -15,14 +15,14 @@ (define (oprintf . args) (apply fprintf op args)) (provide eval@) - (define eval@ - (unit/sig drscheme:eval^ - (import [drscheme:language-configuration : drscheme:language-configuration/internal^] - [drscheme:rep : drscheme:rep^] - [drscheme:init : drscheme:init^] - [drscheme:language : drscheme:language^] - [drscheme:teachpack : drscheme:teachpack^]) - + (define-unit eval@ + (import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix drscheme:rep: drscheme:rep^] + [prefix drscheme:init: drscheme:init^] + [prefix drscheme:language: drscheme:language^] + [prefix drscheme:teachpack: drscheme:teachpack^]) + (export drscheme:eval^) + (define (traverse-program/multiple language-settings init kill-termination) @@ -226,4 +226,4 @@ (when (and (equal? #\# (car chars)) (equal? #\! (cadr chars))) (read-line port)) - (values port filename))])))))) + (values port filename))]))))) diff --git a/collects/drscheme/private/font.ss b/collects/drscheme/private/font.ss index b5a9e955ca..b4aebdfedb 100644 --- a/collects/drscheme/private/font.ss +++ b/collects/drscheme/private/font.ss @@ -1,5 +1,5 @@ (module font mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") "drsig.ss" (lib "mred.ss" "mred") @@ -14,10 +14,10 @@ (provide font@) - (define font@ - (unit/sig drscheme:font^ - (import [drscheme:language-configuration : drscheme:language-configuration/internal^]) - + (define-unit font@ + (import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^]) + (export drscheme:font^) + (define (setup-preferences) (preferences:add-panel (list (string-constant font-prefs-panel-title) @@ -185,4 +185,4 @@ (send options-panel stretchable-height #f) (send options-panel set-alignment 'center 'top) (send text lock #t) - main))))))) \ No newline at end of file + main)))))) \ No newline at end of file diff --git a/collects/drscheme/private/frame.ss b/collects/drscheme/private/frame.ss index 511c75a17b..a468ccae5b 100644 --- a/collects/drscheme/private/frame.ss +++ b/collects/drscheme/private/frame.ss @@ -1,8 +1,8 @@ -(module frame mzscheme +(module frame (lib "a-unit.ss") (require (lib "name-message.ss" "mrlib") (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") + (lib "unit.ss") (lib "match.ss") (lib "class.ss") (lib "string.ss") @@ -17,16 +17,13 @@ (prefix mzlib:file: (lib "file.ss")) (lib "file.ss") (prefix mzlib:list: (lib "list.ss"))) - (provide frame@) - (define frame@ - (unit/sig drscheme:frame^ - (import [drscheme:unit : drscheme:unit^] - [drscheme:app : drscheme:app^] - [help : drscheme:help-desk^] - [drscheme:multi-file-search : drscheme:multi-file-search^] - [drscheme:init : drscheme:init^]) - - (rename [-mixin mixin]) + (import [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:app: drscheme:app^] + [prefix help: drscheme:help-desk^] + [prefix drscheme:multi-file-search: drscheme:multi-file-search^] + [prefix drscheme:init: drscheme:init^]) + (export (rename drscheme:frame^ + [-mixin mixin])) (define basics<%> (interface (frame:standard-menus<%>))) @@ -560,4 +557,4 @@ #t))) - ))) + ) diff --git a/collects/drscheme/private/get-extend.ss b/collects/drscheme/private/get-extend.ss index 36ddd14a9b..6348f9330c 100644 --- a/collects/drscheme/private/get-extend.ss +++ b/collects/drscheme/private/get-extend.ss @@ -1,21 +1,18 @@ -(module get-extend mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module get-extend (lib "a-unit.ss") + (require (lib "class.ss") "drsig.ss" (lib "mred.ss" "mred") (lib "etc.ss")) - (provide get-extend@) - (define get-extend@ - (unit/sig drscheme:get/extend^ - (import [drscheme:unit : drscheme:unit^] - [drscheme:frame : drscheme:frame^] - [drscheme:rep : drscheme:rep^] - [drscheme:debug : drscheme:debug^]) - + (import [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:rep: drscheme:rep^] + [prefix drscheme:debug: drscheme:debug^]) + (export drscheme:get/extend^) + (define make-extender (λ (get-base% name) (let ([extensions (λ (x) x)] @@ -87,4 +84,4 @@ (drscheme:unit:get-definitions-text%)))) (define-values (extend-definitions-text get-definitions-text) - (make-extender get-base-definitions-text% 'definitions-text%))))) + (make-extender get-base-definitions-text% 'definitions-text%))) diff --git a/collects/drscheme/private/help-desk.ss b/collects/drscheme/private/help-desk.ss index b7049840cc..3ea337d2ee 100644 --- a/collects/drscheme/private/help-desk.ss +++ b/collects/drscheme/private/help-desk.ss @@ -1,7 +1,6 @@ -(module help-desk mzscheme - (require (lib "unitsig.ss") - (lib "string-constant.ss" "string-constants") +(module help-desk (lib "a-unit.ss") + (require (lib "string-constant.ss" "string-constants") (lib "mred.ss" "mred") (lib "external.ss" "browser") (lib "help-desk.ss" "help") @@ -10,15 +9,14 @@ (lib "list.ss") "drsig.ss") - (provide help-desk@) + + + (import [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix drscheme:teachpack: drscheme:teachpack^]) + (export (rename drscheme:help-desk^ + [-add-help-desk-font-prefs add-help-desk-font-prefs])) - (define help-desk@ - (unit/sig drscheme:help-desk^ - (import [drscheme:frame : drscheme:frame^] - [drscheme:language-configuration : drscheme:language-configuration/internal^] - [drscheme:teachpack : drscheme:teachpack^]) - - (rename [-add-help-desk-font-prefs add-help-desk-font-prefs]) (define (-add-help-desk-font-prefs b) (add-help-desk-font-prefs b)) ;; : -> string @@ -190,4 +188,4 @@ ;; open-url : string -> void (define (open-url x) (send-url x)) - (add-help-desk-mixin drscheme-help-desk-mixin)))) \ No newline at end of file + (add-help-desk-mixin drscheme-help-desk-mixin)) \ No newline at end of file diff --git a/collects/drscheme/private/init.ss b/collects/drscheme/private/init.ss index 339a1944c4..e81e52285f 100644 --- a/collects/drscheme/private/init.ss +++ b/collects/drscheme/private/init.ss @@ -1,16 +1,13 @@ -(module init mzscheme +(module init (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") "drsig.ss" (lib "list.ss") (lib "mred.ss" "mred")) - (provide init@) - - (define init@ - (unit/sig drscheme:init^ - (import) + + (import) + (export drscheme:init^) (define original-output-port (current-output-port)) (define original-error-port (current-error-port)) @@ -53,4 +50,4 @@ [current-custodian system-custodian]) (queue-callback (λ () - (message-box title text #f '(stop ok))))))))))))) + (message-box title text #f '(stop ok))))))))))) diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss index f9bba9187d..b988e113be 100644 --- a/collects/drscheme/private/language-configuration.ss +++ b/collects/drscheme/private/language-configuration.ss @@ -1,6 +1,6 @@ (module language-configuration mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "hierlist.ss" "hierlist") (lib "class.ss") (lib "contract.ss") @@ -21,17 +21,17 @@ (provide language-configuration@) - (define language-configuration@ - (unit/sig drscheme:language-configuration/internal^ - (import [drscheme:unit : drscheme:unit^] - [drscheme:rep : drscheme:rep^] - [drscheme:teachpack : drscheme:teachpack^] - [drscheme:init : drscheme:init^] - [drscheme:language : drscheme:language^] - [drscheme:app : drscheme:app^] - [drscheme:tools : drscheme:tools^] - [drscheme:help-desk : drscheme:help-desk^]) - + (define-unit language-configuration@ + (import [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:rep: drscheme:rep^] + [prefix drscheme:teachpack: drscheme:teachpack^] + [prefix drscheme:init: drscheme:init^] + [prefix drscheme:language: drscheme:language^] + [prefix drscheme:app: drscheme:app^] + [prefix drscheme:tools: drscheme:tools^] + [prefix drscheme:help-desk: drscheme:help-desk^]) + (export drscheme:language-configuration/internal^) + ;; settings-preferences-symbol : symbol ;; this pref used to depend on `version', but no longer does. (define settings-preferences-symbol 'drscheme:language-settings) @@ -1869,4 +1869,4 @@ (define (find-parent-from-snip snip) (let* ([admin (send snip get-admin)] [ed (send admin get-editor)]) - (find-parent-from-editor ed)))))) + (find-parent-from-editor ed))))) diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss index 26e0efc04e..88ea042f89 100644 --- a/collects/drscheme/private/language.ss +++ b/collects/drscheme/private/language.ss @@ -3,13 +3,12 @@ ;; user's io ports, to aid any debugging printouts. ;; (esp. useful when debugging the users's io) -(module language mzscheme +(module language (lib "a-unit.ss") (require "drsig.ss" (lib "string-constant.ss" "string-constants") (lib "pconvert.ss") (lib "pretty.ss") (lib "etc.ss") - (lib "unitsig.ss") (lib "struct.ss") (lib "class.ss") (lib "file.ss") @@ -22,15 +21,12 @@ (lib "distribute.ss" "compiler") (lib "bundle-dist.ss" "compiler")) - (provide language@) + (import [prefix drscheme:debug: drscheme:debug^] + [prefix drscheme:teachpack: drscheme:teachpack^] + [prefix drscheme:tools: drscheme:tools^] + [prefix drscheme:help-desk: drscheme:help-desk^]) + (export drscheme:language^) - (define language@ - (unit/sig drscheme:language^ - (import [drscheme:debug : drscheme:debug^] - [drscheme:teachpack : drscheme:teachpack^] - [drscheme:tools : drscheme:tools^] - [drscheme:help-desk : drscheme:help-desk^]) - (define original-output-port (current-output-port)) (define (printf . args) (apply fprintf original-output-port args)) @@ -1199,5 +1195,5 @@ 'drscheme:language:extend-language-interface 'phase1) (set! default-mixin (compose default-impl default-mixin)) - (set! language-extensions (cons extension<%> language-extensions)))))) + (set! language-extensions (cons extension<%> language-extensions)))) diff --git a/collects/drscheme/private/link.ss b/collects/drscheme/private/link.ss index d4824bf170..60377115bd 100644 --- a/collects/drscheme/private/link.ss +++ b/collects/drscheme/private/link.ss @@ -8,7 +8,7 @@ "module-language.ss" "teachpack.ss" "tools.ss" - (lib "unitsig.ss") + (lib "unit.ss") "language.ss" "language-configuration.ss" "drsig.ss" @@ -23,56 +23,36 @@ "help-desk.ss") (provide drscheme@) - (define drscheme@ - (compound-unit/sig - (import) - (link [init : drscheme:init^ (init@)] - [tools : drscheme:tools^ - (tools@ frame unit rep get/extend language - (language-configuration : drscheme:language-configuration^) - help-desk init debug eval teachpack modes)] - [modes : drscheme:modes^ (modes@)] - [text : drscheme:text^ (text@)] - [teachpack : drscheme:teachpack^ (teachpack@)] - [eval : drscheme:eval^ (eval@ language-configuration rep init language teachpack)] - [frame : drscheme:frame^ (frame@ unit app help-desk multi-file-search init)] - [rep : drscheme:rep^ - (rep@ init language-configuration language app - frame unit text help-desk teachpack debug eval)] - [language : drscheme:language^ (language@ debug teachpack tools help-desk)] - [module-overview : drscheme:module-overview^ - (module-overview@ frame eval language-configuration language)] - [unit : drscheme:unit^ - (unit@ help-desk app frame text rep language-configuration language - get/extend teachpack module-overview tools eval init - module-language modes)] - [debug : drscheme:debug^ - (debug@ rep frame unit language language-configuration init)] - [multi-file-search : drscheme:multi-file-search^ (multi-file-search@ frame unit)] - [get/extend : drscheme:get/extend^ (get-extend@ unit frame rep debug)] - [language-configuration : drscheme:language-configuration/internal^ - (language-configuration@ unit rep teachpack - init language app - tools help-desk)] - [font : drscheme:font^ (font@ language-configuration)] - [module-language : drscheme:module-language^ - (module-language@ language-configuration language unit rep)] - [help-desk : drscheme:help-desk^ (help-desk@ frame language-configuration teachpack)] - [app : drscheme:app^ (app@ unit frame language-configuration help-desk tools)] - [main : () (main@ - app unit get/extend language-configuration language teachpack - module-language tools debug frame font - modes - help-desk)]) - (export - (unit debug drscheme:debug) - (unit unit drscheme:unit) - (unit rep drscheme:rep) - (unit frame drscheme:frame) - (unit get/extend drscheme:get/extend) - (unit language-configuration drscheme:language-configuration) - (unit language drscheme:language) - (unit help-desk drscheme:help-desk) - (unit eval drscheme:eval) - (unit teachpack drscheme:teachpack) - (unit modes drscheme:modes))))) + +(define-compound-unit/infer drscheme-unit@ + (import) + (export drscheme:debug^ + drscheme:unit^ + drscheme:rep^ + drscheme:frame^ + drscheme:get/extend^ + drscheme:language-configuration^ + drscheme:language^ + drscheme:help-desk^ + drscheme:eval^ + drscheme:teachpack^ + drscheme:modes^) + (link init@ tools@ modes@ text@ teachpack@ eval@ frame@ rep@ language@ + module-overview@ unit@ debug@ multi-file-search@ get-extend@ + language-configuration@ font@ module-language@ help-desk@ app@ main@)) + + (define-unit/new-import-export drscheme@ + (import) (export drscheme:tool^) + (((prefix drscheme:debug: drscheme:debug^) + (prefix drscheme:unit: drscheme:unit^) + (prefix drscheme:rep: drscheme:rep^) + (prefix drscheme:frame: drscheme:frame^) + (prefix drscheme:get/extend: drscheme:get/extend^) + (prefix drscheme:language-configuration: drscheme:language-configuration^) + (prefix drscheme:language: drscheme:language^) + (prefix drscheme:help-desk: drscheme:help-desk^) + (prefix drscheme:eval: drscheme:eval^) + (prefix drscheme:teachpack: drscheme:teachpack^) + (prefix drscheme:modes: drscheme:modes^)) + drscheme-unit@))) + diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss index 33172a3f0c..0d4f898c47 100644 --- a/collects/drscheme/private/main.ss +++ b/collects/drscheme/private/main.ss @@ -1,13 +1,11 @@ -(module main mzscheme +(module main (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") (lib "cmdline.ss") (lib "contract.ss") "drsig.ss" (lib "mred.ss" "mred") (lib "framework.ss" "framework") - (lib "unitsig.ss") (lib "class.ss") (prefix pretty-print: (lib "pretty.ss")) (prefix print-convert: (lib "pconvert.ss")) @@ -17,24 +15,21 @@ (lib "external.ss" "browser") (lib "plt-installer.ss" "setup")) - (provide main@) - - (define main@ - (unit/sig () - (import [drscheme:app : drscheme:app^] - [drscheme:unit : drscheme:unit^] - [drscheme:get/extend : drscheme:get/extend^] - [drscheme:language-configuration : drscheme:language-configuration/internal^] - [drscheme:language : drscheme:language^] - [drscheme:teachpack : drscheme:teachpack^] - [drscheme:module-language : drscheme:module-language^] - [drscheme:tools : drscheme:tools^] - [drscheme:debug : drscheme:debug^] - [drscheme:frame : drscheme:frame^] - [drscheme:font : drscheme:font^] - [drscheme:modes : drscheme:modes^] - [drscheme:help-desk : drscheme:help-desk^]) - + (import [prefix drscheme:app: drscheme:app^] + [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:get/extend: drscheme:get/extend^] + [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix drscheme:language: drscheme:language^] + [prefix drscheme:teachpack: drscheme:teachpack^] + [prefix drscheme:module-language: drscheme:module-language^] + [prefix drscheme:tools: drscheme:tools^] + [prefix drscheme:debug: drscheme:debug^] + [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:font: drscheme:font^] + [prefix drscheme:modes: drscheme:modes^] + [prefix drscheme:help-desk: drscheme:help-desk^]) + (export) + (application-file-handler (let ([default (application-file-handler)]) (λ (name) @@ -414,4 +409,4 @@ (λ () (drscheme:unit:open-drscheme-window f)))) no-dups)]) (when (null? (filter (λ (x) x) frames)) - (make-basic)))))) + (make-basic)))) diff --git a/collects/drscheme/private/modes.ss b/collects/drscheme/private/modes.ss index 0481346b2d..82302fb68d 100644 --- a/collects/drscheme/private/modes.ss +++ b/collects/drscheme/private/modes.ss @@ -1,17 +1,13 @@ -(module modes mzscheme - (require (lib "unitsig.ss") - (lib "string-constant.ss" "string-constants") +(module modes (lib "a-unit.ss") + (require (lib "string-constant.ss" "string-constants") (lib "class.ss") (lib "list.ss") (lib "framework.ss" "framework") "drsig.ss") - (provide modes@) - - (define modes@ - (unit/sig drscheme:modes^ - (import) - + (import) + (export drscheme:modes^) + (define-struct mode (name surrogate repl-submit matches-language)) (define modes (list)) @@ -47,4 +43,4 @@ (λ (l) (and l (or (not-a-language-language? l) - (ormap (λ (x) (regexp-match #rx"Algol" x)) l))))))))) + (ormap (λ (x) (regexp-match #rx"Algol" x)) l))))))) diff --git a/collects/drscheme/private/module-language.ss b/collects/drscheme/private/module-language.ss index 9060d03ac0..ff58c364f1 100644 --- a/collects/drscheme/private/module-language.ss +++ b/collects/drscheme/private/module-language.ss @@ -1,7 +1,7 @@ (module module-language mzscheme (provide module-language@) - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "mred.ss" "mred") (lib "embed.ss" "compiler") @@ -14,12 +14,12 @@ (define op (current-output-port)) (define (oprintf . args) (apply fprintf op args)) - (define module-language@ - (unit/sig drscheme:module-language^ - (import [drscheme:language-configuration : drscheme:language-configuration/internal^] - [drscheme:language : drscheme:language^] - [drscheme:unit : drscheme:unit^] - [drscheme:rep : drscheme:rep^]) + (define-unit module-language@ + (import [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix drscheme:language: drscheme:language^] + [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:rep: drscheme:rep^]) + (export drscheme:module-language^) (define module-language<%> (interface () @@ -554,4 +554,4 @@ [else (loop (+ pos 1))])))) - (super-instantiate ())))))) \ No newline at end of file + (super-instantiate ()))))) \ No newline at end of file diff --git a/collects/drscheme/private/module-overview.ss b/collects/drscheme/private/module-overview.ss index 0d1c7736ec..86d642dfee 100644 --- a/collects/drscheme/private/module-overview.ss +++ b/collects/drscheme/private/module-overview.ss @@ -10,7 +10,6 @@ (lib "string-constant.ss" "string-constants") (lib "graph.ss" "mrlib") "drsig.ss" - (lib "unitsig.ss") (lib "unit.ss") (lib "async-channel.ss")) @@ -24,12 +23,12 @@ (define adding-file (string-constant module-browser-adding-file)) (define unknown-module-name "? unknown module name") - (define module-overview@ - (unit/sig drscheme:module-overview^ - (import [drscheme:frame : drscheme:frame^] - [drscheme:eval : drscheme:eval^] - [drscheme:language-configuration : drscheme:language-configuration/internal^] - [drscheme:language : drscheme:language^]) + (define-unit module-overview@ + (import [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:eval: drscheme:eval^] + [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix drscheme:language: drscheme:language^]) + (export drscheme:module-overview^) (define filename-constant (string-constant module-browser-filename-format)) (define font-size-gauge-label (string-constant module-browser-font-size-gauge-label)) @@ -738,10 +737,9 @@ (define progress-channel (make-async-channel)) (define connection-channel (make-async-channel)) - (define-values/invoke-unit (add-connections) process-program-unit - #f - progress-channel - connection-channel) + (define-values/invoke-unit process-program-unit + (import process-program-import^) + (export process-program-export^)) ;; =user thread= (define (iter sexp continue) @@ -864,7 +862,7 @@ (preferences:set 'drscheme:module-overview:window-width w) (preferences:set 'drscheme:module-overview:window-height h) (super on-size w h)) - (super-instantiate ()))))) + (super-instantiate ())))) @@ -886,11 +884,15 @@ ; ; ; ;;;; - (define process-program-unit - (unit - (import progress-channel - connection-channel) - (export add-connections) + (define-signature process-program-import^ + (progress-channel connection-channel)) + + (define-signature process-program-export^ + (add-connections)) + + (define-unit process-program-unit + (import process-program-import^) + (export process-program-export^) (define visited-hash-table (make-hash-table 'equal)) @@ -1003,4 +1005,4 @@ (let-values ([(a b) (module-path-index-split dr)]) (and (pair? a) (symbol? (car a)) - (car a)))))))) + (car a))))))) diff --git a/collects/drscheme/private/multi-file-search.ss b/collects/drscheme/private/multi-file-search.ss index f4e7d31594..c5a5a11869 100644 --- a/collects/drscheme/private/multi-file-search.ss +++ b/collects/drscheme/private/multi-file-search.ss @@ -1,8 +1,7 @@ -(module multi-file-search mzscheme +(module multi-file-search (lib "a-unit.ss") (require (lib "framework.ss" "framework") (lib "class.ss") - (lib "unitsig.ss") (lib "mred.ss" "mred") (lib "file.ss") (lib "thread.ss") @@ -10,13 +9,10 @@ (lib "string-constant.ss" "string-constants") "drsig.ss") - (provide multi-file-search@) - - (define multi-file-search@ - (unit/sig drscheme:multi-file-search^ - (import [drscheme:frame : drscheme:frame^] - [drscheme:unit : drscheme:unit^]) - + (import [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:unit: drscheme:unit^]) + (export drscheme:multi-file-search^) + ;; multi-file-search : -> void ;; opens a dialog to configure the search and initiates the search (define (multi-file-search) @@ -715,4 +711,4 @@ (car pos) (- (cdr pos) (car pos)))))) (loop (+ line-number 1))])))) - 'text)))))))) + 'text)))))) diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss index cc68e21d60..764adc710f 100644 --- a/collects/drscheme/private/rep.ss +++ b/collects/drscheme/private/rep.ss @@ -18,13 +18,13 @@ TODO ;; user's io ports, to aid any debugging printouts. ;; (esp. useful when debugging the users's io) (module rep mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") + (require (lib "class.ss") (lib "file.ss") (lib "pretty.ss") (lib "etc.ss") (lib "list.ss") (lib "port.ss") + (lib "unit.ss") "drsig.ss" (lib "string-constant.ss" "string-constants") (lib "mred.ss" "mred") @@ -60,22 +60,21 @@ TODO #f (current-break-parameterization))) - (define rep@ - (unit/sig drscheme:rep^ - (import (drscheme:init : drscheme:init^) - (drscheme:language-configuration : drscheme:language-configuration/internal^) - (drscheme:language : drscheme:language^) - (drscheme:app : drscheme:app^) - (drscheme:frame : drscheme:frame^) - (drscheme:unit : drscheme:unit^) - (drscheme:text : drscheme:text^) - (drscheme:help-desk : drscheme:help-desk^) - (drscheme:teachpack : drscheme:teachpack^) - (drscheme:debug : drscheme:debug^) - [drscheme:eval : drscheme:eval^]) - - (rename [-text% text%] - [-text<%> text<%>]) + (define-unit rep@ + (import (prefix drscheme:init: drscheme:init^) + (prefix drscheme:language-configuration: drscheme:language-configuration/internal^) + (prefix drscheme:language: drscheme:language^) + (prefix drscheme:app: drscheme:app^) + (prefix drscheme:frame: drscheme:frame^) + (prefix drscheme:unit: drscheme:unit^) + (prefix drscheme:text: drscheme:text^) + (prefix drscheme:help-desk: drscheme:help-desk^) + (prefix drscheme:teachpack: drscheme:teachpack^) + (prefix drscheme:debug: drscheme:debug^) + [prefix drscheme:eval: drscheme:eval^]) + (export (rename drscheme:rep^ + [-text% text%] + [-text<%> text<%>])) (define -text<%> (interface ((class->interface text%) @@ -1787,4 +1786,4 @@ TODO (text:nbsp->space-mixin (mode:host-text-mixin (text:foreground-color-mixin - text:clever-file-format%))))))))))))))) + text:clever-file-format%)))))))))))))) diff --git a/collects/drscheme/private/teachpack.ss b/collects/drscheme/private/teachpack.ss index f9d606b967..348be17d9a 100644 --- a/collects/drscheme/private/teachpack.ss +++ b/collects/drscheme/private/teachpack.ss @@ -1,6 +1,6 @@ (module teachpack mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "file.ss") (lib "etc.ss") @@ -14,9 +14,9 @@ (define o (current-output-port)) (define (oprintf . args) (apply fprintf o args)) - (define teachpack@ - (unit/sig drscheme:teachpack^ - (import) + (define-unit teachpack@ + (import) + (export drscheme:teachpack^) ;; type teachpack-cache = (make-teachpack-cache (listof cache-entry)) ;; the timestamp indicates the last time this teachpack was loaded @@ -166,4 +166,4 @@ ;; should check for error trace and use that here (somehow) (if (exn? exn) (format "~a" (exn-message exn)) - (format "uncaught exception: ~s" exn)))))))) + (format "uncaught exception: ~s" exn))))))) diff --git a/collects/drscheme/private/text.ss b/collects/drscheme/private/text.ss index cd8571bd7a..4103e4a7e1 100644 --- a/collects/drscheme/private/text.ss +++ b/collects/drscheme/private/text.ss @@ -1,15 +1,11 @@ -(module text mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module text (lib "a-unit.ss") + (require (lib "class.ss") "drsig.ss" (lib "framework.ss" "framework")) - (provide text@) - - (define text@ - (unit/sig drscheme:text^ - (import) + (import) + (export drscheme:text^) (define text<%> (interface (scheme:text<%>) printing-on @@ -35,4 +31,4 @@ ; (get-filename) ; "Untitled"))]) ; (send dc draw-text str dx dy)))]) - (super-new)))))) + (super-new)))) diff --git a/collects/drscheme/private/time-keystrokes.ss b/collects/drscheme/private/time-keystrokes.ss index fe9599d718..e6cc180255 100644 --- a/collects/drscheme/private/time-keystrokes.ss +++ b/collects/drscheme/private/time-keystrokes.ss @@ -2,7 +2,7 @@ (require (lib "tool.ss" "drscheme") (lib "list.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "etc.ss") (lib "mred.ss" "mred") @@ -16,8 +16,9 @@ (λ (i) (string-ref short-str (modulo i (string-length short-str)))))) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) diff --git a/collects/drscheme/private/tools.ss b/collects/drscheme/private/tools.ss index 5e9c7a78b9..969d09cef3 100644 --- a/collects/drscheme/private/tools.ss +++ b/collects/drscheme/private/tools.ss @@ -1,7 +1,6 @@ -(module tools mzscheme - (require (lib "unitsig.ss") - (lib "getinfo.ss" "setup") +(module tools (lib "a-unit.ss") + (require (lib "getinfo.ss" "setup") (lib "mred.ss" "mred") (lib "class.ss") (lib "list.ss") @@ -11,22 +10,19 @@ (lib "framework.ss" "framework") (lib "string-constant.ss" "string-constants")) - (provide tools@) - - (define tools@ - (unit/sig drscheme:tools^ - (import [drscheme:frame : drscheme:frame^] - [drscheme:unit : drscheme:unit^] - [drscheme:rep : drscheme:rep^] - [drscheme:get/extend : drscheme:get/extend^] - [drscheme:language : drscheme:language^] - [drscheme:language-configuration : drscheme:language-configuration^] - [drscheme:help-desk : drscheme:help-desk^] - [drscheme:init : drscheme:init^] - [drscheme:debug : drscheme:debug^] - [drscheme:eval : drscheme:eval^] - [drscheme:teachpack : drscheme:teachpack^] - [drscheme:modes : drscheme:modes^]) + (import [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:unit: drscheme:unit^] + [prefix drscheme:rep: drscheme:rep^] + [prefix drscheme:get/extend: drscheme:get/extend^] + [prefix drscheme:language: drscheme:language^] + [prefix drscheme:language-configuration: drscheme:language-configuration^] + [prefix drscheme:help-desk: drscheme:help-desk^] + [prefix drscheme:init: drscheme:init^] + [prefix drscheme:debug: drscheme:debug^] + [prefix drscheme:eval: drscheme:eval^] + [prefix drscheme:teachpack: drscheme:teachpack^] + [prefix drscheme:modes: drscheme:modes^]) + (export drscheme:tools^) ;; successful-tool = (make-successful-tool module-spec ;; (union #f (instanceof bitmap%)) @@ -211,9 +207,11 @@ ;; invoke-tool : unit/sig string -> (values (-> void) (-> void)) ;; invokes the tools and returns the two phase thunks. (define (invoke-tool unit tool-name) + (define-unit-binding unit@ unit (import drscheme:tool^) (export drscheme:tool-exports^)) (wrap-tool-inputs (let () - (define-values/invoke-unit/sig drscheme:tool-exports^ unit #f drscheme:tool^) + (define-values/invoke-unit unit@ + (import drscheme:tool^) (export drscheme:tool-exports^)) (values phase1 phase2)) tool-name)) @@ -365,4 +363,4 @@ (error func "can only be called in phase: ~a" (apply string-append (map (lambda (x) (format "~e " x)) - (filter (lambda (x) x) phases))))))))) + (filter (lambda (x) x) phases))))))) diff --git a/collects/drscheme/private/unit.ss b/collects/drscheme/private/unit.ss index db2da2b3ce..4142abefae 100644 --- a/collects/drscheme/private/unit.ss +++ b/collects/drscheme/private/unit.ss @@ -13,7 +13,7 @@ module browser threading seems wrong. (module unit mzscheme (require (lib "contract.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "file.ss") (lib "etc.ss") @@ -42,26 +42,25 @@ module browser threading seems wrong. (define show-planet-paths (string-constant module-browser-show-planet-paths/short)) (define refresh (string-constant module-browser-refresh)) - (define unit@ - (unit/sig drscheme:unit^ - (import [help-desk : drscheme:help-desk^] - [drscheme:app : drscheme:app^] - [drscheme:frame : drscheme:frame^] - [drscheme:text : drscheme:text^] - [drscheme:rep : drscheme:rep^] - [drscheme:language-configuration : drscheme:language-configuration/internal^] - [drscheme:language : drscheme:language^] - [drscheme:get/extend : drscheme:get/extend^] - [drscheme:teachpack : drscheme:teachpack^] - [drscheme:module-overview : drscheme:module-overview^] - [drscheme:tools : drscheme:tools^] - [drscheme:eval : drscheme:eval^] - [drscheme:init : drscheme:init^] - [drscheme:module-language : drscheme:module-language^] - [drscheme:modes : drscheme:modes^]) - - (rename [-frame% frame%] - [-frame<%> frame<%>]) + (define-unit unit@ + (import [prefix help-desk: drscheme:help-desk^] + [prefix drscheme:app: drscheme:app^] + [prefix drscheme:frame: drscheme:frame^] + [prefix drscheme:text: drscheme:text^] + [prefix drscheme:rep: drscheme:rep^] + [prefix drscheme:language-configuration: drscheme:language-configuration/internal^] + [prefix drscheme:language: drscheme:language^] + [prefix drscheme:get/extend: drscheme:get/extend^] + [prefix drscheme:teachpack: drscheme:teachpack^] + [prefix drscheme:module-overview: drscheme:module-overview^] + [prefix drscheme:tools: drscheme:tools^] + [prefix drscheme:eval: drscheme:eval^] + [prefix drscheme:init: drscheme:init^] + [prefix drscheme:module-language: drscheme:module-language^] + [prefix drscheme:modes: drscheme:modes^]) + (export (rename drscheme:unit^ + [-frame% frame%] + [-frame<%> frame<%>])) (define-local-member-name get-visible-defs @@ -3167,4 +3166,4 @@ module browser threading seems wrong. [frame (new drs-frame% (filename filename))]) (send (send frame get-interactions-text) initialize-console) (send frame show #t) - frame))))) + frame)))) diff --git a/collects/drscheme/syncheck.ss b/collects/drscheme/syncheck.ss index 2035a60a0f..64ea481125 100644 --- a/collects/drscheme/syncheck.ss +++ b/collects/drscheme/syncheck.ss @@ -17,7 +17,7 @@ If the namespace does not, they are colored the unbound color. (module syncheck mzscheme (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") + (lib "unit.ss") (lib "contract.ss") (lib "tool.ss" "drscheme") (lib "class.ss") @@ -67,9 +67,11 @@ If the namespace does not, they are colored the unbound color. update-button-visibility/settings) - (define tool@ - (unit/sig drscheme:tool-exports^ + (define tool@ + (unit (import drscheme:tool^) + (export drscheme:tool-exports^) + (define (phase1) (drscheme:unit:add-to-program-editor-mixin clearing-text-mixin)) diff --git a/collects/drscheme/tool-lib.ss b/collects/drscheme/tool-lib.ss index 0423e9a8e6..deaa4baef2 100644 --- a/collects/drscheme/tool-lib.ss +++ b/collects/drscheme/tool-lib.ss @@ -11,11 +11,11 @@ all of the names in the tools library, for use defining keybindings (require "private/link.ss" "private/drsig.ss" (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "framework.ss" "framework") (lib "splash.ss" "framework")) (shutdown-splash) - (define-values/invoke-unit/sig drscheme:tool^ drscheme@) + (define-values/invoke-unit/infer drscheme@) (close-splash) (provide-signature-elements drscheme:tool^)) diff --git a/collects/dynext/compile-sig.ss b/collects/dynext/compile-sig.ss index dfb63fb005..76b1009cf4 100644 --- a/collects/dynext/compile-sig.ss +++ b/collects/dynext/compile-sig.ss @@ -1,6 +1,6 @@ (module compile-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide dynext:compile^) diff --git a/collects/dynext/compile-unit.ss b/collects/dynext/compile-unit.ss index ce1349b03d..4535de336a 100644 --- a/collects/dynext/compile-unit.ss +++ b/collects/dynext/compile-unit.ss @@ -1,6 +1,6 @@ (module compile-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "include.ss") (lib "process.ss") (lib "sendevent.ss") @@ -11,9 +11,9 @@ (provide dynext:compile@) - (define dynext:compile@ - (unit/sig dynext:compile^ + (define-unit dynext:compile@ (import) + (export dynext:compile^) (define (get-unix-compile) (or (find-executable-path "gcc" #f) @@ -289,4 +289,5 @@ (define compile-extension (make-compile-extension current-extension-compiler-flags)) (define preprocess-extension (make-compile-extension - current-extension-compiler-flags))))) + current-extension-compiler-flags)))) + diff --git a/collects/dynext/compile.ss b/collects/dynext/compile.ss index 8854a62755..3db5acd2f4 100644 --- a/collects/dynext/compile.ss +++ b/collects/dynext/compile.ss @@ -1,12 +1,11 @@ (module compile mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "compile-sig.ss") (require "compile-unit.ss") - (define-values/invoke-unit/sig dynext:compile^ - dynext:compile@) + (define-values/invoke-unit/infer dynext:compile@) (provide-signature-elements dynext:compile^)) diff --git a/collects/dynext/extension-project b/collects/dynext/extension-project deleted file mode 100644 index 7aa312b63b77327415f6480f29a95c9096d057f0..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 89730 zcmeI534j#E)yKPMmp!;|5JUzLLBRzPbOnXIIAvjlMG!BB-2oQ%%I=`3L|43xNxX8$ zNTNy1sZpcGTxir7W1=}V#wf-!F)`8T7ZYRney^%}X1b@lXOK-K?iBpH{$2I@b=9l) zs(bqytJiSLiddPcfFc{rwd_-_B9D+iLeVwwQp-MVJ$baDt*x0HS$nc&*L};fPk6?% zdf!4>haHj4b*gS_jIWM$bTqYfMC&@*Hpd$hPE`-dBa<;5xX%qF zkAV`a=*7Fp+dwIh)CqbkW?4JP`ygLOel6&06+QbP`Hi3-kaP#=ub5>?-2mjf$R7g( zt)jo|CVvhLI&V)=JNav1@XNH7{2yQlUHA~)lYI`=eX$RK4+A7y`h`16vX5dhqTrPW zkA*LQk7Qqu!dJp&n?>-G$wz4$+O6=>fMjoHaiF4>eFga#t7uFGyFo@TEkJovJHhZ9 z$X6JCJNZh(?<21_T*h&g;m?qtX!u{qR~!B>a`7QjQC}7(DQXpozpphMTU!zjq#_wx z{6bQZ*z#0Gts-fcj5nz$#zO2%Dr#Y|P8j@L7E(tl5+7Kvs8w_od4u8CkxQRRMPFtS zSJW!HlYE2W_mFQi{892vhCff8;kAm3v6K=NkId)!j`-Nn>BR;Fx{tk*Le zOIl@SYw-~qtdOHJNw29TW@Pp`Z;yy)EK6*)nQS7PtK<;Ll_n)4yVk<8ML)F}$AsEg z!=iYsG2YQxX2w%1NiH32$pX=nQmb04c8_2$P0VgmTSV!AbfS;!wX`+Fno zmYv+0xf z96(n0EvbeCs8DqqN~y)IoCBzjtjLwFSiam$VOpYa;fhse4zvo3SGH~KXoz=8Ra$vL z>56!#Z%w2ht`%L{w7w(O(Uh^B-M@0#%Ej*LXiHmT(}t#aV_CGOEqYel*65kB)W=ef3<48q((tG6CSdcdzHO8am9X7;M$kogJ+p)pQplE%@Ruebq^)j zb4XfB+Q=D;^gDeUv*I_oNk4KQyX?L0#lCcO>IPt{jA>Js6d|c*EH#y=2CH_uTbbUC zOs+dtK}8ji)=dR+O1Biq>4*5u1|X*#a*83RW=8-y^^nspPLbqvOPzYiX^fn{917%= zWeS)8EEFhQDE;-eh4rYLvpd1_x4g@2?JTL|v0wloZf+&zv zn&SY6KThrS>G}cWlfY!alq{$3#FhNXp-&&=v_VdHp%>w z2ZKNZC;^RN7#I#V0h!kh1{1+x(A`PKrpZKPz4_y6vzaGShj{T0vA>L*jEnSK##HAg zneEn^`Yk4cnoXYhr=^UX^j|C|Hjti+4YdA7)1J7=jjQkNA&{Nu{V3%*?7j2@?PL4i^t^`uSqs#zTs(i!;?_jGqcxt0 z&fnJF+}07#I9m$u-r~64tSr7wjzRg<<1E18d=P&bEMFO|=Th_fwr$a)%H=d^FH-Wf z)v~+R?AnVB14Kn%vTBumrCl01C%LYO-Q`~2=QU0RdM{hPtg?1~+59#0{nb@Sv7AZC z!sMB)Gt;}8*!2m9Y(dgz;mq{uC&R%<4ZV>pQ-9v>mq)!`v9h+%YX=po6J`-;w^T24 zu}S{$C-&^oDS!Cu(ZkU-y{JGgvy!X;i~ z=MT?bi}c8KiGvMXO-sdtj*X4@4VNF|=k-XdCVn!vJ=SgAg~RY;H)|jer|j_By~tPkRH{2)Myzb2H2429?c?IeRnU#+Tg;T0kpk z1MT2_fJ?15_up+!jP0#}8)Ehu;7qU$oCU4}p8?l{o!}GT)8MnaquZ{BltY{ z0{9}h3495B8GHqN6?_eR9o!6V0p9?h1h<0Q!0q6hSgZ0v*v4AjVplM?5qc?fZWKO2ju4E8Xz|`<%Z?KU?MmKOaf6b z0Zaymg2TXAFdj?+Q^Db&3`_&l!4Y5vI1u&IE@E!17@ICN-unXJ+?gc*p_W{PwIv1P=y1@D1 zZ18@t16%+u1ZRQm;39A_xCC4ZE(4c?4}dGc2f>HHhryNLDsVM82V4WL1s?$)1-(EK zC`U=$b)4g_PsIuHZv zK?67ioDLd69Bcq5gVVr9un9DQ&0q^?1}&f!w1IZ;KF|R=K?0l#wt_RjnP3}Dp)C>m z5}~aT`Wd1B_S@vNQ<^Eyo<^`m1Y6kuBBvh_Y+~;r$0iYM5}_{<`Vyfp5&9B22#f{T zDiQ_b0Je%?s|fapV6O=FieRq@_KIMa2sVpgC;Q*zW(M>8TnFB3zo6|bMOm5`z+dRu^;vPGVQnM zmqouU`epqP`Q@MvoB&o(Mn5e2VbKruoU`<|9KIXSCyPE=^vS{|me}AJa_Qe}Fb5pV zI(@b1t3_We`fAZvi+)=4)1sf2^z$_!c03Nu1@k}!Wp9FifPaFw!0VJ(lK&n23%m^& zJL_-Y|EQ}X-$PyvYQTIzk(|`p5l{f|H@g=o0>wal44<;zAYT9$f<<64I0Q@rlfj{2 zJeUX$15?0MFb?1|_TiumOas%w5nu*563hg%z)|36FaZnz1Hm9L81w-vL4Pm=3Eg9E`Ba1a;^qM$EW15N^K!O7q}&;`y1JHR>MTyO!n z5L^V#24eH~1F_G=fU&YK0hfZyfY|+V@BwfI_#pTY_%OH;Ah}1@N@7BOFw`^_Mb~tvCgK3-XCk^XzOg0V zny_Z;dpJBD7+u`b-qw*&HvwzwR;RC4#hRPj+FGNF;?3<=?doXtwCX8SwBYJ!U97Vq z)~wc6#Lu?s<}Yw>n%;t=%C}gv&D}=0x_v|&8=8`BtmDB^cdMl&t$DJVY=T)aO^`KE z+1X;Psb0Py*$!2nYL=`zjex60tZZs-K1;gUS=L~st#ovDG+63R`-WIUoMu?HvBV~o zuUr~kv9&eP)DjmZPEmE4Yi-Ju)VkbiEo)Ax;BISlL2UBOrfKDkhb9#mom3`^s>_n1 zr>BcD2tGA#>n*6Pw`QlF^L6@7vFf*HEX=B771LM$y{}xneAOD+f3lsr#Oc4YtMoCa zE@^tzGIwKZ=2xv+h$n6FxIn6Ww%-P#HK;uE2KQ`tk)!)~MmGIkc&glY1KFqF2C9ed z3QWWhxRhsZomrws&b65oE#!i@yz&*TZfiXw-oY~<)`I5vHeUUTw|BJhTySSwhgH?o zNw~U-YVlX?NRwwYrQFT&p;V#vZyEDsnXJ^r*Kgezb#+66&9_|S7c{jpD`d+1mD4Ye zWMzAMb5lbs(bU!|!Ec^iMqAp0%AV(zXQzd2gO$Fff_QdSQ|oMP1e&dUHdT}sre>t7 z+ge)MT4%dL-(BTQ1hY-VI(ZcJYDb>gA-Okqm}m=$C6_j}ZecX5w{|AlTB66t&pNZM zqp{PfY>+`^noVr#wCZC#u`jcCBGJ^kv6IQXIgaVt+tpgt)~4o0o(D>F#5yfCU>oBd zQN4|&CvE!G&Nl2u&EdQ_*s2xP*RhM%c(b*5MRa*P(^}KnNST>6xs_Q@ZYJ#(Z(JB} z)!xw5DUb8Fte0J+bxJ5l236#|q(~W4wb?6&4iuTT#kVEmt(`LVvy)WKoT6r7bK816 zE7eB*JbbjiBhJI^$zB`lTfE)SzBLhD&>X{Db+LvmF|mp6>VNLQyT54Wj4s2$_LsKh z+mW}xf58ID8RWmPul;ftJYzh2zie2(QSXWcdRYbil0hMdRXJmEw?yvINphF|7uM{s zy>e+~Z__({af&NATppBVE-Aa5_f;r&SGo#bI-$<&=+VM$4^D@3twX=NU+~iLUGU+6 zB-d}$wN~L=+fmnCg>wx^U3(RNJd06)q~7BnZFoC5*K8!oJqmSQRyfy1)Vuq_uV*n9 zkmSCD6%_{OT8O&-E}Ux|>N>vgmsm(UNH*7NRKgzJ^h~Y19b2F-tQA+t^=O&PX3uVF zZD`)w7@uv$TjHq|v-5n`Gb|t>w1-5-8>!+KEoXP~ekv}(oR&Z0^$ah_>}8r?$jpIX zG?>3D^FEPjt)5eo<`;z=+4JYbJ!j}cd+PW_h1~lt5>Y8p_sJ#Cr@RG}1?0|dORTB2 zN1KB?+U}%c#a)zN+e-_)n{Qc|rpjMg`INW7yJ>-8W-iH3DevYew#WZY=5z8+x7>RY?Jzm9aaglc70LN-16N#^uDLDWgXit;Z#{O8l$UpLA^pwsdkOFQzCHE43!mNA#Z!xy-e34c`Oddn5< zJGtv=d-^d^{cw8M3%$D7_l3^BxBqa?S(*E8cvbW+;`w#9ohthl-R!^o(ihObtFW~G z#i##$3^KISk!|{s-WoW2dxKTBy{X^}%eo4qmyWe+rt&N}{fnOW>|5K; z=kCFIH@>{>{41>I78RF`>8iAb(#J(Rp0-NPyRmrYO~b7lk+&+ktiI)3y``@2O=nm) zmUE?UyHz|>fxj^-cUVKq&%++qv2m{_OQoHnzw0wREYCjB|K_6N!+D0&8hYN&;+g0i zKpQH=hUZ^k6;eNt`s-x>9y^TGb|`owWrv2VM89X-m~4CL_4X9;ulfrf+k^g^9rLV` zuJ>6xyBc_LpuswJdqeT8iu0|hJN8iiG0M*b7otn*FSMe_jNjfkvd+k9{~KB~kN!`h1Ex)BnT@Iquh3BT{l1f8;5>$noDAos#qalL4V(`^Vp26x8SSw;7z1n-PJ z>a4i+Ii;DoBNxl^{=FlYsli?H&gFFftUDW~8;w!vpM2*gX&32VvX6EwBVJWO=Zk>Zm})CLKmr1`XuU|d)&#fbGE|MU4Ae7i#tBd_%q+A z_N2)r>v^Z-&P^3+_Hoov=ho*`IJxNGp!^H9x0wDa1QS|I-taSt5y?(TBYwBB2nEUve%`FVv_&8gHiPwZrJVs-Xb&ic37*E~{ZJ-+R( zwYO7rAn(ofshz)U6|?JldH9;Li&xgKn85ngb#-m)S-)dNQ{z(ddt>oLocyQMN6DXP z?}%?8e?gvCCV#EImhY?c<{6LrcQWJluIXrNXV2pcH&JR*VUv1G^K@A)+^n7sx9rQkPW$zt!+1+z|V^;`;4hju+kZRF77w zCU&FWl?Be|dJC2Xp7%Y}n@zL5PtLpF3DGjHr|JC!yieHs$#|Z+&wR;hw(CiJKNa$d zg!ABhP<>7M!}LKy=BxHC)WCItRH;W?>_10{r#HYeZwI{Ce#e_YC_n6N`2M=6`_y;m1=p5!nci5 zXMX-Epg#4sg`a@y4Gcel)lID{q>tt$4L^}>F7<%pmm$c!JcYHn2yYAWi!$0B!aQQjdf;NIlg) zLF$pn2vSeIH%L9zo*?z9^#-YrNXj}sm1(2usm%;hUx9RQ^$H||)KlRNQctxfNd0Pq zo1GSG z?P)d<2y0m@Me)}mSt}-QD5tUi(jipQpcNAsTyW%IaIz4jyYh7dFFJeZ+ zztXXDX00bef&`M@hfCri?cR0wqG)Cw}PM!|>VO>+${~f!1}r z+<&uRySqF)bK?-7){c+QWby2jT!??Cgu=Z%B^T!FDX9>TPYDJ4y;~;4``v=RqvRIx zACZ(yXgqku0=zCw%r7=l)gcj*64K5Q949Hs@My`9%i8+j$Vt-`9zSluEaT%JOKug} z#xEqUQi`%h7g}WNBy)+bG`Xy;M>gQNq#af1$|brS!7Sq=`;+rA_rb=!uWaLo zj@0>BkfM<2lBRkeXmP6%iI9kr>hM?+iLfY=`jGgM>fp$6YC~ei5%C=jr_$ffQX3i} zDS-g*QUZQaAr&Fx%YFFLyQzwmT9*o-G@P z__SPF3-@V}2=QsD4)XeNBRCB0E`rU*eHA=?6H>rI&cNT(_c&?ELiKSmD50mj7lT>TcubTU*k*On_ z1w|%{1w|yA1(Pyi7EB89bYW0?bFiSO$!0-ECd7h{h<}Tju|jMowSiWX%3ymXYlHXe z?`5)KsC7gj*e*`3uSJ|n|2B!Gg8fKp18pId!L~@&2JhG37P4WeEkq#L7EZ0NEu2cH zP1wfoi|iRk-5@#Fu{TJ_djt-Wb03F;q+CbiAR#Gtjv8Syt|N1pps{9{NLHJwFQ_M< zhYeDt59!GxVxX8lZUCPJ}ldWrxBL^wb6Jq*>mLN&*DMJ>ytY*UDvpRyv zpo{1$;OiwI9 z)vk#pNGN?`36;s#HD_W8Qj$5b1W9@)mMn6~i6u~uK+fg}YTNXea>A5laRk{^CYCT2 z*{sR7sfi^>k!xZJ67ozeL1O6>OPEZSzNb$t5`aFx36n9g1j)H3mLMVT#1bUuo>+pU zToX%>kd!Wsy&L9U4<@; zWLy(Vm|)su?Po99pA&sSYCIE5xL7h`0>x5iEPf4gO)Nn=(kGTsnQUEiCYB&2nG;Kp zq<3P;BA3-nvVAs35Sg4DK?Jinf`~Y0EPmsn>dnL=JU}Kju>=XZCYB%}&%_cWmOinB z$zv5|kJ z6Gxe~p2;CdAnETu0(wHotZ+>Qnbql&KtOG9vz@@t+%PlbGiAKN9w-sgZShwpzhVpywc+8SKPS-(9>59e=di1Yi5ZLRW~ zkn)3#qSUVwe$Dffb2raVLd@Z9o}Zj=^O8R`l`&1GYFyJ}s@OX%rfS^NVXE9U4W^2{ zrbyMKPmJzTS8Tbfj0d_4orp=5dL}+^MKbc!D)dB`DoBk@s?0U%rHV6WrBt1`h%=M8 zO9Of-8)WoS3T4J{Ysl<3a;X_2CG46RQpH)EMg}P3CqGkLOPfNfUB3;Q+A8S}&aZ@~ zs#e5X+7fX+cck^Sa%-aP@PzvH)wEJIPjCmICDz&~_KJJ!l5=UqeI1PUXw?uwFs0Q4$e7*CLY6%-|E+xU8u^)M(- z)HKD&Uj-$NirWL>rO;-+i6md9>kVy#uY~tGQ_GwI?`z8W^?9q`wnV?h<{L`=&yXKj zSHJdd4Tv|#`6j6Rio7)tHMBW006xfYzQJS-*87T_1Rt_E5pO}}{qUiQw)RRm-$J#9 z#VecnUR2~>`0%#YO4=5A20o%um%j}k$#3tn--0pl1GXi4V~>Kl@KKE=3)!|nz7sV% zo~WUn1v}se)-&Gl&%wte`qa|Lf_vZxZR}qo@}ht2){X|@(*EdHeuEgZ4ug-QPhIet z@bRsU@kaQG@Cow47P#2w;K;1kZh?OUJ`s=#Z)0(YqE_Lr$tM{u`X_7NYY_RNAj+`K zAV2K%27cDq>a`L+B{J(-#-tbhx29S}&+mfE_#UqPq1Tt-Wq{P{K^D`rKlJ)Ne7g3B zBKbb$5!xS$WS=v%KNRuZE9*$@4@H~cGqpbyiT+u7jEZi8AEn2=NXFu5?GHt};pL{B z?`>JfXn!a^2tHf;L-9QL9PJOqr^1ibK2Ur%{5Zou4xg*{ReU#mp7w|0-@q%hKNP!Ka|LK z!xn3QD3!5TqWz&%V&Qo052efCOSM0g;;&XMxRS8Bgk0*dap_mcmjfIA6Y@I1cgRZr zLVg0^yO+KDk*@&#;i6y0n0@vZef3}{T;hBc7y-YCT>LBozma@3;JcT-e?Y#bw~F!J z&%ueM!hwV0H@^hu zBg@tX_+R1I!8aN%W3kEbU%{Iq<8C4AD{-+I{y0<2VE7jJgYc>FX2aQ^)na%Dyw&h) z;cbTB3U4=D^uN#W*WewR_wNhuH2g4l0?vN>;~&;m!#BatfMbXLm%-1B9CdCx{EP5y zR#E&(_jFLh3>*i)P);M6cB|kQH6)@n za2bn>AZO!+%Wv9mB=1zN`7jG34Jfd_K9@h%{2hdY3Tx)hzB& z)EX)6y4Ubuk^jK(e~{m&`2lhay5I0>@&^o$lmF0giM0m}mv%~@Ne77RLyB4lJWnp| zCXFg!@vx%Ss6)tqVz}u4so^nl@o&YqaQp%y4NxbCsmgpJnkIMXk|d?@^8-4}(Zo_XSf5vdx|L+Zdi~L#5#~e)loZ$<}#df4ITUflHs5M5$@kPVM zUtTg?`tb+D-zNW~<_Aq8f7$TmqM@R?V$Ko%FS_jE~{;K)dV)9oF zpF;kc;dSJ4ydjO<%HnlJt+CgUzhSue+W#3Y?fSds(ShV*Q&Mym3-Lcv^duJlRMd)! z4~UIO(a*Dx`G^!1Uz2{4qSD5HD{76CaS=ZtjXO%6MreLA+*Z^YcM&{dICFqqU^xC_ z7aC4m>|UCW9}h1wd_G)kK^h;2ml%E-ywq^!68-H|WbjS9k159~Hvq@BxNzg^P_y6Rv>|GW-tsV8ccK5W^WC8@-YarrsWA_>u78hA)MSjYtRMSN2H5 zKMX&>@Nd9J87}%q8!q|})O@0}e~jTrz-7K5O*|ex*6=2H)bLB;;|%{I9Ggm-$T->) z49Ayki2>3fz2OrLKMXGO1?iB*@JWVmgikj7a`>T!i+;9|bjba1@mJx*kUdrNNyYHP z4UfXh3@4WDX@)nzryG6|oPJ80B>HCXUs4PODL50VZ&174x1b?7JHm4<&8 zUS&9Ql3lI&VfemXV>ouT=Nn!NUto9(e4*jj!WS8S7o4$?bl7jK zuQvPwIQy0~^*Z=ThJO#f*6=6cCma3`IAbR1aAL?l)o|=>pJuq|Ki%*v;Oh*R_Qwo= z48Gp*x8V4hq_TtIY_B*rw&R9xfp0MUYWPOOzXji9_~Y;kM=i%pSK0|!qJj18My9~!K?DGw0 zJ9~%WJK^|&q#5_YFEspR_(hr@IT(Ji;miT{C5Gcu=3Cg-k+j#o%#>dbXFig2#_+Gf z>A$3-ehuHLsCCpo;Gfm}=rQom8D0aw!EpT4zR_^(XVX4ON8b$pg5ke_f6?$a;Wues zJ`#?NB$Zdezic>hV1LDMY-WGe@H^nNRZ{uW@ULrrOa#vUBpovzev9D?;NLJ@+Ig$t zjE{Yr;djDsH~hEoZyNq@IQx?{TXZ6)_!9VCh7)u4w+v@|?7I#BF8teu{~rDw&F2)s zsgpEk8vJ{PuYluolIENN-=(NEhq1EnG5kLGy@o#v|AFSmmcXf#bnI04{f3_af57nf z!GCBteqldoI67>6NYb${!ynT8xB>7V8(t27*zl9#KQa6q_)iVTckD+Dmv%mC_#fau z(|qng_|FZW3CAZS&0P)urQxFUSB6X9@kL2!or^6W!NtNPne=>X%oVi0%I?FEHix@Iu4e z;JpmL5ME^XC*j40-v%dUB-P;8ky69)i%4(7u~~$^Nt%yrq_5%92HGTP{%m-E!|AWO z)-UCo;R8+icK9H}uZ9mc{7Z1gThjbp@S%!Y^YOvRFvGD;WVq%F#=u7yJ`+CD@a6CW z4Br4BWw`8jwBa9zA87b3aCAvpKpaO7G8|uyj5VAwj6^kGNV_8A44(oYZ+H!Sg5jsa zv5TaIo$!f<sn>gG=3C_Lq&XUXP{4P_u)Q+TaRWVNfS ziT8a=>)3q7$`#f7riB|bC{P}@oRb!g>vba(z7|1W#rZF0v8pgrtIvdz&I9>T-u|bo|1=+0uC$D{q2ZSTf4N% z7$7j?W_EOOOM9E#y;e7~eI)sTv8Emgm?=Gty= zSJtt?etBfd63ckJe)uqO)XkBpVG3vN!6|n=;SI`NPiP=ZBxpj*)e~&F zRE;_^b=#RlO0OTw)~|tV)U9U#S*$~Q%!Ba3j;Pwx9t%CI&0SAJ=&4^e`*b<>X>ZsR z78$wgX%9VmXX{t8Jz0*EIiDeQs;4FCg!Bp**>2BtwT@R^X2}#?7hF8A?=q(?(RAgbl2Z--8Hjx!{1)}=%mUk z#Zz;MWPcZSmuinsdlkZ6&7(E@o5%0v-vo5c+a*=Py3HHlK&N4G6&k+Kx zvzO=KS@ncBDEIb+pVaMzo=`-k?j2M-vpfrQw*a}FNRAg4V!pMz)9ljAvffSRsk zdvZJn&#EWab8vq}$@X;Dkuvlz9bS)6Z_iZPkz2Gr$TT!G|Xo=F7$dB2xu5`lWU z>#CrNobUtXUR-4gyGEd{JLh<{D!f6-BW0jcE>^XD zLJ!<~VV`cg3fCCl=NnC`U;Fsibn?g@dX33#)1Wogo^UgZoqP7xvqY#n2btDY&YR6g z&WNVHcI>KUW$0eb2q^L@aMrb+9A|{AdUBi*vg!$UvET~DZ@ob_~9BzM%Ll0GA~<_m#cnt#6zbjQ4;SomyG?CP^R>B!__lU-yP?eN>8)A1s$By?g#rD+H6|Z zww@;*gVXZ$o1N?FfqEDV=R+6%x90oq#j{m4Vb|05;@PTDJ-J-1%67+Q9Y#~0(Ou6n z?c*~@$(b&bt|!71*s4|eMcx8=3*;@(!!1zI!~37_e%=Ck3#2TNKRHU-BG2*`$XlRi zTA(o5?H)fPDg#9N>+ifaH#NlMi_J;%BuS6AQ_>Q7lD9zK0(lGMEs(cB-U4|GE@c`K-cpqgu>DyBx<4#%kaS{4U1Z*ddhKKB< z=sBv76&ZKRX&kHIpS|8nb>wXFNN82!Bk2oIJmg7?wucB>NlmvZVyU-lus$9I{Xeux3owpPk_)%UIIGxw6yKKii_i4FA~Y9CwO%zkbr zglj zf^Fq{+;(kk^&*)|Z1er{Z$9~`djiVXiSs)ky285;DPpHZ+q;Rfu~-s4p^9?WlYe(J{JZ9%R?fe>S=OF^chk>- zx=fVk-`zBZ$jDM}fM!%B3-a%7CQXq+7&yl3Ct@N5EKCfk*zv;h<_E~R_ zR&e_1orzdS;@z}?t*$`4n=Q!i`(3wyT>BohxRu{uX^khM^S8A(w{>`bizQnl7xR@# z*{m$SEuKv_U;iGoK+&|`TbC@Zx2`>-PWO&`E7zWTi@ts~o3FSZv(>(~bDj10w!2Q2 zD#RS%`uB%hOJ#oj1rpBd|-y4f3#H)TveU$u( z_73$$vlkXL$7H+L>iJ9_`M>!Up-z6(x_3=STRVFmUntjrO)6|sSKdyS)xyo{%GC|3 zs!Ls&c~iJObX+*H{o~0|^9#H7;npn5FE#QN@LLUE!i7n$XsaYw1?8$SXbUT39vn(^AM(p|3oxR+GR_4vzF3)lu7?+Np`pUEy5p=by)8c6PCF}%Samp{{^ujw zlZu8;s$O0*e^PW(O=W#0S>595`bj;>0Nr!_wm{wC*>}6iw8&-me9{(BM~S>WlI~!R znsQfWrSX$`^B2l0b7Vcy+yGjw?lUvBnnUeL>iz{EqcZmzPB!JInEZ63Z=G3>8GY-G z{syD3(ddtx+`AsQLuW^)>KoJ6X-2_2+i`vhPdY`9pTbR4Bn^@$J<|etKj@j`p6~VE zT3}c*RFY(GRpjO0Qx?ek!Fy^r^PTyRSs*ocM$#XV&p#mlAG7%XjN%^ufc(2TQu%0n zH?6-P?mHii8xN8v*jqXi9q!?|nex$6-s~^LT#YVqHG#uOg$%OQpV0mk$^NH!m}d zcnW^7E-#Wt%4Y-8NO>N{TTjHDWzQc zqU~AOBxC(CDMgQL8*NE+il56XQ6`;IA@?d<678Py(jyS)qFlx#O}=Cq>jNp5@klFY zjntB8ZX-)8FYaQ!M33(>Y-=CGI;mLf(N~q*zq*og<3D{)rQFC@Ev39lq`7f^9SbA> zDs8f>Rk77KP5#aWlpk-(WsJ0ZWc)hH(IrXVs&VvxX(;7#Bc8NzFbkvqjZaX%N)=mu zM9&P>&ZWT&A9iyhw_2CeANdiH{(7Ce>472JMkLI&A5-)K)LpZ zr4Ov5{Nt>X#-7VU_p5d)H&N{SRIz=;A*p_yx|Q<#Rk>C2Lvquvn=2`QK$llaT$p~n z{AbD^)a4_-LvH$2j8ED>GV)(0H~soHI_;mC@`uTFzn1<1U$B3!%I!HtwGPHuH|8Vwn$0T4K%3YBjkSa3u7`mY9m8WGV93vNB5PzwM1B=y_XLRu_sJ z>hcR|yZvunJ{x-$4OQj0A0_tRqst#U$g&P=*7C2fm1Boa0|y{etmO|`MY*lZk5AD4 zsFvTzJQgt<6yw8|)_>dOwUkRdkc#n1Gtb<%{gaf_K1s!ov*@q&ETk_HY$R#;I`&(n z%is6|)B_dpDr&sm|V}R zx9$8C<^6T}L37CO)BF81V;#Z1l2-kTc8=8gk9a@j19f@D8uFX8{9}x7gjkZ)`^C%ytiml$yrpjmG zBN2&z((9LFH|_t?p|m+NLYM!8F)cLZ1IJN5QkR$hn7p*5&3is`QWXEu<6Aw5K1B}D z^2PU(>v^E+?opHjNpF9d{pxwUdZmn`9BVOIr| zFHugPN%q(o$@r@3T1)wORc`h961kq2s-C)n@(HF~w$u8ndoede#BWG_7;8(<8`UFa z94D$`tB=@Ik5|=;B7cY~wjoK@$-3MovsbVXRO+%G zwOn??R~B^5dw#}rb(3DqVcmJ_j<>-quN_Jnn&U0;R`nB>gW}r~@zzeh0DU;`<8O{P zBphjvMGNb$uhbvpW&5BIOr+qZQ@YhsC*^QNQ`$jJU5H^;X! diff --git a/collects/dynext/file-sig.ss b/collects/dynext/file-sig.ss index bcf6cd71e3..26a793f310 100644 --- a/collects/dynext/file-sig.ss +++ b/collects/dynext/file-sig.ss @@ -1,6 +1,6 @@ (module file-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide dynext:file^) diff --git a/collects/dynext/file-unit.ss b/collects/dynext/file-unit.ss index fa6c009779..98c61176e6 100644 --- a/collects/dynext/file-unit.ss +++ b/collects/dynext/file-unit.ss @@ -1,15 +1,15 @@ (module file-unit mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "include.ss")) (require "file-sig.ss") (provide dynext:file@) - (define dynext:file@ - (unit/sig dynext:file^ + (define-unit dynext:file@ (import) + (export dynext:file^) (define (append-zo-suffix s) (path-replace-suffix s #".zo")) @@ -82,5 +82,5 @@ [(macos macosx) #"[dD][yY][lL][iI][bB]"] [(windows) #"[dD][lL][lL]"]) "MzScheme extension" - (extract-suffix append-extension-suffix)))))))) + (extract-suffix append-extension-suffix))))))) diff --git a/collects/dynext/file.ss b/collects/dynext/file.ss index 9d8987851c..f592507e91 100644 --- a/collects/dynext/file.ss +++ b/collects/dynext/file.ss @@ -1,11 +1,10 @@ (module file mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "file-sig.ss") (require "file-unit.ss") - (define-values/invoke-unit/sig dynext:file^ - dynext:file@) + (define-values/invoke-unit/infer dynext:file@) (provide-signature-elements dynext:file^)) diff --git a/collects/dynext/link-sig.ss b/collects/dynext/link-sig.ss index 7d67a58008..cf0f5d4191 100644 --- a/collects/dynext/link-sig.ss +++ b/collects/dynext/link-sig.ss @@ -1,6 +1,6 @@ (module link-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide dynext:link^) diff --git a/collects/dynext/link-unit.ss b/collects/dynext/link-unit.ss index 4c38ec524f..b3476e88a5 100644 --- a/collects/dynext/link-unit.ss +++ b/collects/dynext/link-unit.ss @@ -1,6 +1,6 @@ (module link-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "include.ss") (lib "process.ss") (lib "sendevent.ss") @@ -12,9 +12,9 @@ (provide dynext:link@) - (define dynext:link@ - (unit/sig dynext:link^ + (define-unit dynext:link@ (import) + (export dynext:link^) (define (path-string->string s) (if (string? s) s (path->string s))) @@ -425,4 +425,4 @@ (loop (add1 n)) f))))) - (include (build-path "private" "macinc.ss"))))) + (include (build-path "private" "macinc.ss")))) diff --git a/collects/dynext/link.ss b/collects/dynext/link.ss index b8d42ba28e..5c2052352c 100644 --- a/collects/dynext/link.ss +++ b/collects/dynext/link.ss @@ -1,11 +1,10 @@ (module link mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "link-sig.ss") (require "link-unit.ss") - (define-values/invoke-unit/sig dynext:link^ - dynext:link@) + (define-values/invoke-unit/infer dynext:link@) (provide-signature-elements dynext:link^)) diff --git a/collects/dynext/linking-project b/collects/dynext/linking-project deleted file mode 100644 index 96a816c03b1382d5f68bbeaf7ca5361d0bf72afa..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 89728 zcmeI53xE|>{l{nSF1yS7AumDX@)8hS5Cw5j*ku=RaTiutgnYqe_W}$1a`&S6NH@*)dsNr|OR8;Iw*$ECZ7+e{?_An7hJNHNQjvcc&0kpBn_ zu}WUvL;gG%dhyz*oa%os;0FlaJ9hwA1>4<4ULf)G5H_h!{KuPsYvQLMp3J13Hh;xpG7{`@N>w; z?xdnCSR6-tD&Zf2&!;`3;kUt$2UFm?$twVMEBYS!0zlu2eo1};I1>IU`H6t-7xyP$ z2(Ux3jDy&SHWf>|DgoOr79Xwxq~i4~7AtBMpG#hC_LL|C&H`IXD*g$JT1Bnm-;ysk{O{x^Yu-oNDM3o=BkinL)aoPcTw%E6D-CZZZ!lc^ z?G(d5LB7iHo#d+xzn{F(a2dxnhX0)WRKs5;Uu*b3$;F3AB?DNzMNz9n{QWe;v9%@f zKq`^3#V;h4h%L`l)GCp7$#|1W5-h~Nq>?rk8-&3xVj*Ru67hkJidrStk~bNCBf0dM zRPtFCNky%aUF4e#zn6To;ZKlnG5jg=7Q=r>zSZ!*kZ;qxw1~Xb@R8)wK2qrv7VU~! zrQ(AfhRaxW8ZK==+i=nCGW=rlZo_4aQkoxdOKDdRef_XZ*(CYh$ZRZWjhU^*M{KZ4 z_R1vvOD!=Sv(LqQMLla-W~K-Z?z+gI9KW!VSBX@|6BxYb8#=$5En^{r2KZBE8lZhwQLwun^K z&`>A6vx;l#maS{r*3v9TB5PMSRI5#x_R$2B(4;YgmnY6iRJSI&yOZ7J=eHOyb94y5 z+J^Y@s#B|w^og;c8rg;`74x%5iL_jnqFHQo#My;QUJ9hFKT5W>YtwGHR@4q4Kld-` zHU!ntj}4cBz7*nC&JHv{RqE)wYURpCcUkeWRcp)~Xcd>P?%3Ydl$3b0m)6!T5f5{f z7xi70>`rS~u9Db5Tr6JKvau`C)uPrfHtP>G`5==IG5K)U+V-HT6{~AKtGk=%aItVq z+1Zgq{wWn$GWJW;Rkxt?^`o9)&9O48w zp0Uqc5O>yFVo3#_ZKXHrCZ);)MUrV@h9S-oM1%BtKJRyL!Ofkv*>c1p{mw2-_utWV z`jPk8<`vuSBnfJO9Ii-Da3K$0VHOZKqZG5xQ{BhM~qA#xvu+tsPxSnT_`$)h6|7<;fkg?M}%GL2kPBm}r*b$#MUk;P@A*Byn zExTvk?tNG>L{;ib7p<|cvHQj@NdH#E?(zQK?_V4W^jooVMOFQh@+Iq*1XounVmW$} zg~_v9XQp>GvFig2S%ajH!kO&d2gBie4ZV^qGk@M5kbAv8iSmxfvj&x_6J`-=w@fed zu}NX~C-yw3Q(^aaP!E4Eb^gsfrJ707UcbJjy(QI>Xl*%vUk~!uukTJJELn7=-mt~j zujd%Gt))GY+Skpi{cOMXj`l=bGW-y=Qd;KQF~8x)dROFRi|3EB+@~I6v?QNBn0Gt= zU%mdfX)o=i_30-$jfG{b0lV(Fgwtp9zu<3vVfXB}$U*sA;$SQ1H8Sy_V`H24n+vxd zlvXKp8VjWVW|R|P0oMz~NQGJCpm&wRLH;!jWvBjVo)PN;mA*cdN!7^|XkPCm6pcX6#a@Ma7)B}#{)V)^? zuniQ@{~mDu{zgU>cYXjs)YuL@)!)1V@2# zFbm8EM}s-w7;r3@3+4g2pgA8*0LKHlD7pZg0I;crtu1VAVQUMUTG-UO31DjrTU+l3 z*vi7@>Yht%ZDDH*TU*%L!qyhHwy?E@tu1VAFy9=H%(1}+Eh z0Ph4>fGfefz*XSg;A-$5a1FQ?Tn8=y*Ml3td%^oaA5a2HK^d??G3X2Wf&M^J5f}gl zfXUz1LMF3kN_J&6F38`2hAV}Hi6T@Szt5R z0$RXUunn|=HqZ__KqojGbb)S=0%wBl;2dx+*g;chON_q6=wpn&+pm*TB=?-gut5wP z*#9KQ4)$Jh>=45aG3*ed|1tU>qyI7bAEW;<`X8hJ_P@xnf&Dai2K*R23w{8e0zUyi z1wRAd2R{OPz|X-iz;obv@B;WHcoF;x{2KfQyaav=eg}RCeh*#-e*k}E+t@dTePc5L zHjZKA7-JDT8ZZvA!@+nE2aHo}7GP{*j8kj^m?71Czjfa6Fg{rhucs z5nw8q2Bw4A;7Cvo@PSwbSO87{Gr);pAy|aL9|n(rN5OZ%gY;uL`M1Gi;BoK-cmO;^ z*~#QjlGlNHu!7&;1>XbM)56Xcc2W07V{eObuowr6aj?FH{z}jQP64ZsVRs9=Ti9LQ zM=j$+AFVxrF|Zf|i!rbmLrcbtzFRUL^vR}AHhr=f8;h~A7#oYRu^1bRaj_T|i*d0S z7j<8@j5~d|>AOwe?MmdYg4e*`!9T#Ckynxb4g3?l4*muH1pZ3dV)DJ@)u09}0f^L9 z;~04nz^Cm#pahhHGSC;LzmP8l%fLyX790Vlf@xqnVEpYVfbp{#D;qzu@e7;rwi#=i zF}3j-n=!WWDH~t0@f90ivGEnThup?j>`7oS7y^cZVW2-)4F-Wjz;G}E^aBGyBfwwm zHQ-dR7K{R;!J%Lb7z+*q$f1I1QW*E(Sf|ZQv4c0k{af9b5`71Lp&= z`CEb5=W_50cn5eVxB`gXuLSP`SAlnftHFD~HQ-us9k?D`2yOuH1&pEG|8Bn@d=-2R z+ylN2c7d;eZ-Cw4UT_z{AM7s!d_wM#xBmpb3GN3EfWLzW!MDIe;M?F~@CbMmd`F4T%2fa?dWKapOkFvwCdN!t7lcun4uNd#v2mdO^H_ZYgO`mt6|Af z@2c(=%$vW>sxVg@;p*}cZER{ux3Pg+M!l^TiK}_?Gu;I9!!$vDfvWB{YhCrqrRjDk zd8S$N(`f`;HDYy3YwLN^&F=Ch%k`tHyQ|4kSK2ovnvyibs!yc0sC;!@eAV{$R7+b@ zDse>B<(^+NW@LWLrPlJ+Och*hjW111JGN!k{O0ND3QV08rbX4|Y1Q>^RR$rT#B05! zRgG3f<_=${--uPeePdyMI#w}#4c_|d+Lde8$@bIj)Doxv&ZgXBPFdRYs%75B)+|}P zW*MHe&F2Ccc}36)Qfrtz`vP}`SLD=vG9&B07M_s@t{~eCT0!;DTY!le0#D`HYiCRJ z$az*1(K1em%OhX$>W=nvl3ko%x0bdhckt*}va_p$`+~bWx~#=5-Gr-0RFA)EN18UL zCF5?64`qbfzh%tRGWk)H+_-&n+|vySwm`Y)FXgO%Yk+=`oPPNM&t@pGg8$ZZEYRx6`s)d7C93^ zg^5@vk5j$ckZ*QKZ_OJf+M;5~x|a5BjAr%r?o>xx{N&_$=XP{8cUx6WGN??msV&`B zV}g72W%f>`TG}^vGnuz0F zr-ZU+P$K6cMPy9XW~=NvsK~S}xg(Wq@0PKzNK-X)ww>R6UOO|ijN@vVhK-HYaJFJU z`r=-vyF;nEMxw2WJ(y?eCN@34)6WBBsbKjEpFDd zc&4Irdn&%PHNj9dB$~D*WIVK)***UU5=UHF4)!0|Y+(}x3mhmGaHfR=r9J=gc5nxB z#eaOGg$*9C7U;tt(V5+9cgM!;mdZ7{?k%kWCE2>YDzRnDVKvJ6k9|yU^uehZ+xd4s z3gzv}HAT-1+hBV3MDdP?IOjq-T1$$a8E{QeNoQAb)5Ux5{|U0?TF$aXGdUMw6^jO^ zv-%IWOZqcF`B)~xen_oUB_{p2eInY8fRLu?@C(D&(xSPgm$wO~AdSmj?h?kI@UfRqgIDs#^>qKNT}}GTo@K?QfAXYw+Ah++bRW6Xc-JQ0`l+}7 z#<%Njzw_&Vzdpxbnr9pPRVsVA!%o>Vx#4s8H2sY$z4SX*u*C0wwnyy!l8$le`Rj#g zyKvu`JM}PLMZbS?CS!KfHe24~5^GTPxz7@($1byGx;`b6?Ij%_X8bpGGM}heN$aJ{ zxyy6cmP-AHh^ddVv|eTtE++MFQvOA?x10VFZcJOEC3VX-RpM?o>UZi>&+w>kx7`OWK8d|$wO;-nh!`Tyy zw;(mCxJ8|RQg`7LZ&goXenJ)Xs3$OA6>js*3zl+zN1pAP7FSQk!H<%sY~=|kQjb*$ zzr*n5ToAiWasBjf@7>j-D-AuS5B+;oufej&_q>OCvZ=y<=e+ls5Uu06n?6Xve}{dL zj_Ja^&;RUwZ^I5*CRmDjj$rVmpxPYr|>J2%@0mHVCu2vB3=bu8#Gf!ItDR`d12vS(v(!NTb_An1=1gY$pKQGd&r98r6 zrPvv5lk*%APq@^zbo(8Ir^Ipuyl6y(yA($UyJ$p(x|Bx*x)g_pxl;mQV0rdDToMcDGm?obZL0AgF{+Y%oWh06CKVjjfifChq78fI*=We z&_R>hvxC@KE!-}w7Z$*>azyw_ab)m{LU`yprJ+4?hb?aCeVR8YNPQaqAoUdo1gTFW zD@c9i{vh=g`+_u})E}e)DjDkp6uL&$SDGE9feLPK^(&-<)K}mSQeUwzNP|klo9zlx z-->}j>eC4b(qN5Qh$&JsAQ}YQ0N*}Uukxb1}eC{ z)vu5aQeS~TNPWe=APp)FZ?-E)eJchAsZS>$NP{&Zy6p>6|M~$z8lVz7Xs#d)SS{Qx z{vh?O>|lt=tKvpOCzG&;X$g_ zj}B5tC3Mh&gVb3q+%6G8Dl10>sT4;BsVIa8sZ$!-qwpYg-WihXFVl=(M8Ia0qQf?$ z7Zto2t%wlLD1`^IS0^Hzy^4X>^r{5=LPjSt!2N0={_au>3ieEKM9629az$uHGdfPQ z^m4X7JZ4>WMMthzF~|4>N3pkxT;mrJ(V2=O;#wBK=dTg-4eZ=Zr2<$}hS^GoR>k>E&!ax*?}A zGrlD{d5w=K<`^GQ$v!3I-BzygqmHoCLz#*^(WUL{`u0;+TxDx`A}YJsA4}O9-YCj0 z_ryce@P>qQ8 zi61%_r2^LXdwj4;sC6AL4_+QX<0PXQ9W7aUIa?nd zIj*{*R$y-IP@r#J7Ohq}Pi(2xEF44;wU80mvbctT>=n}1*(IrZ`qRY|A z8C{NI#OOIHQKKU|c|=!6Ez&=gT6lCxan9%xrTn5xH1mlrmtM}+qZ_hc(vGU?$|t%U z#T?@!+mqul@6N`%tz6?r9hu{?u!meR-w$tZ+)mr@9d3Mq()2Pw`K38E7n11^n-_MsKx_iFuUk9Sl; ztt+)>d%3e(xZTkR^K4l;!l&ibTC`7#MubmGakNj1MwCxWd4x|(akx)Ar4c^us03Qw zDGau)lt%h=Mj^y!ltPeCOF@KBOK~or7M*CHc4kGn}-FZnp_ribRsP1s06o| z87sneQW|PCDGaw)x-@*d!CodSMp{P{!tLUe23o`^3~rNHD%_8xG}IPS7;cMnY4~=7 zZ6Pa0+Cmhy+J*FKWtc4dY7KwBZjK!{dQQfXYU=R*PMwZtdi`BB}~&lvE*PMwZtdi`BB}~&lvE8G* zn4WiH3DfdSEMZDw9><@ebUYJFl%i|04zibQ&xyXUYJ3w*v|2i1Le(-yEI|$OOe|q_ zxF?oKom^dWCYG>DvL}`>P5;D_LocV9Wc^%@AUb(Df+*&21W|F0Sc1kym79r0c!*AB zVhL07Oe|qazKJDF%{{S1>E!6Udt%{)FrQp=eJe2QSS4G-Gnr%;`=^m?4etb!UGAAW zvWwl5MsTUeOM+F5je-lEILa>dO%7oSX@3t;&=W#-foCenE_P1>A*JEXb^s76G$#b2EO4_Kel9D^nmgbtb%N;n7C9BvoZ%Y<psj>HH1=W@Q-k%QN&_CstroXKi)vB6~CeMC0 zXp7RrB|Dmue4nwSUA_q^A8eFLgE|q^ydXVq^MW+Q9RB77=>;|~{i&&}X);sdnI1D@ z|FoDX@lJ;sxn~;8i2bI>l(;8GuhbJ;-Xi0HUZE2)8L4mL^B1He-&LR|x{M$*HW`^` z(#wdmXQfP;xQH{8c%>n|lohgiDMFbsyftL^8@k5t)3oYud1kqcBlkFr zBlNqABlkLsBlWn7BlJ6pBX_%rTjnvJyP!^g%+)P&4CTmt?%@@uog*#QuHpR5IEEwf zxP>Fkb_%D&?GkQTV2@nx;MNsq@ccGMe=b?Z5geh%4IE*l6NvG%zP#$JDNPG4^n9Mx zStC8h&SzSkf>p`3j#N_bHq!m7+Men-Dy2TVo0h5F0~dbU679_rCP{BeddJ~Ztn}+w zE$6Go%Io+xuBXVn0mmcrdy9V#c9cEen017{Z_PSl-_F+&i}9V=!7U4P1yK&Qw-nZS zJzqplU(Cy-3R%Gdy<`E~>PpIc(k26W8@Hq-ps1y_wT4{2kXRg>dv~1tU7%0tvSf<< z^PnVE-@)74tVcm21Z{0zafSm25-jt?=Qg zj?OChjqnl4s#d~rnzhx z>lVp-;>IRZHMFzn68K?_?2O?z!^fri*VD(Md*O#~9#kXxQvdkvT}{HJ{qgO5gB-Jt zfKQ-LJ@8}U6Wg1U&G1vaIw$i*xXlchrbs-1(1rr#Nr4=t>Pb&Pc>ZXpQd@A zq2$v+oMD?oe&qTlK5K6ESq+~NoBJGN(ue+AGp&*rcEe?SkJA3o=T>+*AoY2O#VqX) zeSQI-t^J`y-mZVN_JzX zkT(F{L)iCa@>2kBneQjx&sYTp!KHo~W476^p1ctZhfAEV0i)oTk&B0_a6^Gy*1TB*8fBnXKZfc>-AQDiHkEWJ}M8t z2!0mF9inp+i}hWp_&oS-_=b-5_(|}e!4um4{Uz=;%HRA<2XS~)@_gy%0I9#3Rp-M` zhbLnbzVIu!e6e*C{15OO;hPPYvDjkx58y4a3Ad9Ckhs_ie~Kw)7dqnOvRN1m6XhzQy5Bl3%IkpCNyNze~?Q zL-9rHDn0)UJs$pUJ^u_9f4mxyhD!bK(euyH_rtHz^Uu&P!mriy&(O!=*Xj9Z=-lGx#KjGI{ux#df3KbshSkB}r{|er;>hpU^UpAeyAK%o7vLY%^UtvF!#||wpJD%m ze^}2yhfIWjM9(>gEQ8-@_%`@Q^|lTX|M{4ne-06w+@$B9Lw*eZI3Nv=vA9`LYxs2X zPZ*AWShpD7M*c~|#SWh`{2S!rH>BY&viOXm)`a7h8}QJdK6K25Dpui!TX-OM7=JYK{Ch`JINp zLN2jN8a0B2*o8DoeBf?Htx+4uzihaS%U2ASet*^QN65csxcJpQnvWhw{&mBbkc*8- zqh+jj3xi+B;$B6q(bBH_4F3W7Hw}M{{C>?3m3`0yhF6n6Xn2zRTZT)lJ!H7FQ~FFg zRCFI!)H?J9a%nedOc9Gm6}843LH-@XrT)hZPmqg$lg3=a;t55qF`popxFU@a8+=z$ zYmE5S_YB`l{(a5IP9T@Qk;Y2>KUCBjEA{`#aA`ktm87vBXYsV6)>yIkGlq*ywm};E zDvM_owGJCa{u9F&k^j{2X7ZmIeiiv1!|x#fx#6Wy7uD@v>A3`oRCB^5m z5dR~^-@@YWidu2;0kIJ&{z(=xACcnXYtm0rT-x|AMXd=kF5(BI3G>upgyyHiZAGmK zm%(F(GY8m3hT|`GvEj7E?xXp{iSQD`m%zmqq=`v*nc-K!`x?$%qTij24!&vkH*)M@ z572zlaJbAbq)F1wL580SA8hz`xY&p^>3aB3!|#F*GhFIF#Bj#Prd~;tDYr)$ehhr1 z;dOAa5ot1hWsf%eJ@7*f{~~;h;Zpxt!=?ViG@l~vA7}W{aG5ViQ%;7DH@pQNH~gLO z35I_fj!h*^VI1vAhU3e&!~p4te())V9|@QFf^O@F2R_$u z>|ry;lBS&qKhE$o;PVZ?0DipTAA?sIejj{+;nMySG@p)7+0-RzI{mX38omlnA0$mb z2VSYDHT{F|D#P!AFE*Sx$*$J?NPOR}F&w+vOAN1vFEzXkzRd6&;3pY=H=MDNbmWiW z%MITP$0sDsz+Y_qPjUKZQ?KId;42J27rxT)YvB!s-vK|x@F(E(Q__sz!B=ZOQ*6>` zIKE)7F`TyBryAZ2Uu*c=;cQ#d%p2ivG5qWB(+qzWe!AhW!5K42M-fBznTBI;`z*ty z{`H1m1>az}v_E0^kKh{({|6jDlT@a1HuxsPuY+$k{LAnyhCc;wG5mG- zR?TM-b2jTsnk9B2D(Gnv&443gb&v1OiKHqSu^8&*^0Kd@id*E+1`~~<$n$Hm* zxY+R7@E*hQ3;S(`vz~p4;WxqY14(o4hhJ*=OYqAyKV}&Ga>JPe>~|QBPnmb&TgT8| z`wAof7@YY?(lOtFzsvAn!|@48#}0+R+wkMzR~vpNoVi%iv22rXuW5cO{941m4aW~8 z9V`BSz22~C*jys(p;(YgNFYR{vplhjf8*L@P+V? z7>=LXHyVBg{G*2dADsS6n)gHaO^RCcUW0#J^W(YAs-_?0XHrAAXyCk+2J{7KCh4uOBy@MGclgrtRQ;omo0>imJ>(sz7O(n9QK|H$y4!k;o+ z#^`Cy7mb5IWB3C2j}1Qy{;c6r|4$4jZfxq3w1{!D@h8Pu&)#GBpW#2(yz&q@V=1Zf zXgFh_cmw=-!^Ll3Fr2x;{-xo!!(TKU8`!@x{10$!B&ka3|Bd0Z;f#l*D)G198omY2 z+##vz9q`{9{wes&hBMB5TT-Pe+G77v^TjdvD~8A6e=>Y2oPJ7L+zS7T;WxnlYB+IV z|IKi*|Ero;_lGk_NUA;t{&&OI!2enBk0RY@Ferh97SDSK;Fg$3J6n!|~17 z1j8Bg*hI~jVW-$6!&xszn@o(H~dEUk%r#^pJDj7 z;4=+>9)6VOC*c>da>MCIY?k5pVT|~ZbW$ChSXDd$pJVuTIC@I{9{90_e-b{|@ZIov zhJPP^oZ(`V`I^^C8|bs7TE;5IcqmRAV+#zgfuCUbI{1l(pAE;4CDk%l#1Qc-<TzR#87whm9K>vOR8;uok-QQHQGD!8Fy7r zj>hC2$!+`PKFU_AJwCg6jK~k}81jpTN61(UTrRPQE5ub&uKY>fM$9`^$lxt_N$>zeQD9N-oF0WzzPTCo+(Exu`9%)NCM#|NusPYC=SiYZ!e;cUB^(aB`Ci@*| zM@R?cp1Zg91ike)TyM=Rz3{i!embf0O7YZuB01QFy;AM*u4iAo#oStRpn3d0{!KvF z{9V$&_wjFn@OpabZ-N6dl5@<=>0^XY>+It(c+PsF8^QS3P+igNIbplWtF*$KW~Z$@dsMxT17>dTUP^`IiolN2sS~ zF+xP@tz+*PPo6VE z&U*5k5pvcO?PBSfC3iiM73Ez|Z$)x%okhtJ$+`NKo)LQMY)qt;)gHyn2;l>!XO?`= zr{}6C&tv(JYI+C`-JU#;<#X1P@3DMvMd|kBxERj3t9NBMu^p7Fesv`yrzoi;*=KmR&LztoKFv}hp}+peG+_W ze!xE5TU8TvK7AkVt%|HCpR-lDuGnnAXv#Bs>t3e)yay>g)8%&$Qlx!!Ll;pCH z=7-k=MMtl}LH%}y(FQb)?~xQM)@ zvrEou&XUJHGG{l}YTd!|tVpreSaA=WXSPf-XZP>ClsB7Qtu;=#owCfCj2&9@tHaPJ z(;6j9khPc^cyp6xyLlqa9-=k6A4it?TWx^WxR+ZE zYh3s`yd$k)>iEemylhO>aq-?eKS60{TEjf!b(TECHc{8{nfu{9V`Y-D%yYEEGIiX2 z1w3KPc-CM4&;1nX7}2h<0c>OHBzWc=gz43bf6w^X#Z_oz9>chtU!>o?Gvi~0KM}M|3d@283KlqsEf5=|U-jJD z(v*<*^k1`IaSFpgF)B=Tbp>NWGEp#hy3rGy)7Y9YQq_lGV>RP$7Uq}bB z1-7J8ofWfY$$i=7-P_yCn>yNN@ebDJ?M5znfqAmPEpk3u z>d1Vb>-CD$pX*JF_2+t>pFA0y{=}+V=J~{`yTI2VSzo@k>sIkM5FPp2uBAQ-?kIA< zdFF9XM`+gMQ{t&E9u#uK)!VyM9c}TGljoh=(bb%hdp@@8D0@Di>xbw& z^Ma$|?-x3muW&n-44fA{AHWt(nK#`Zz;EqiOMW9$Tp?G zHJojp;mm5Kblls@;JsYtNwVN_krtlaN<=;jRCsnP+;=vZq66yLt-gGLR8LNg9UZM3 zJ9dP>2{^20&e0Wrr1Y%Y9j2APTt-^1& z1=g?cP9@}1iC}+YJ}-WR2`8DtJcY`0e%$-5ac@cHDhB zPu5t6@jcA`^-ET);e%8gDGrMV9IeTigByy`K^uzKc2+IZtbldaO$L9fmLGOZK-Z&I<>~OEur0 z{iE71{5N+Fg?)kM%%1gB^8w4XG8>cD8UKEZH9-A7&C-9Xo^Ir4n0&pd zZ-e=rF!gOT^*5RNnoa#llly;%ZqV7#nbsiHkh4q$Z*0SbDO?#*76<(lZlWS>kODb4 zEl}`-gLB*qz1~*~j7Wz{n(S*81^qXb1qy!frW(#dXZ~##$jqHF_sx=pTP6Q(7XP2A z_@KX4^1nG!g=qY5TK@ptb|D%!A8uK7R$F%}^P)L5PG3SkR^+YTVVhoKS$#$Bd#8{+ z4ZUf|TfF*n&@VIf7yT+zW^;+N#MJMW4?M==q@S+eEiXmisoyP+Uyc6Ew$5(0>y}Ua z3i89+Qk!YNTi*9C)U&&xjyryfPLV#0*KHd7bMkU^QMBm8?}Zy(j-8)6N&)j(jU14U~47c3vr`d(G<; zN529$?R;J?-kMkPjg~Po?R@5s@N)rayj-j`?Hnb2H!t&xGrp#sMej?(%`5!M#15vN z&&sR%-T_F5j?A?4!H*$$rxIIbkCK~q-g5<9KpNPeg>Gl@$Rpr4h!h{3#KN@m;UBedT3{ zJ;-HDT>528`8@==jE76!?>T-CZ%ehxs}5cA(jI>6S7XLjU|aimev?YY9{Sac_7AQ> zZv3bJnaGX);yUDuMVkxfH?lDLf22)zwGvwcT>86cn|-p8%NS|>*u)LUsY}wpA{M6p zTZbc;3-P4Q!&sR5|MEfPYn0gPFZIk({#p0jZOF|yCMvO8gOb-zN+37mSo$#fdVK2# z5DWH|x}E_tzVmfG&pw9yDlP9X{ytFGbLAf7@7D4G;xqacn)UYc$j!J9xEHy8k!byz zcOf_9J`{g5{!l;VdgNx@M{Po`{h{u`4ah&hZ_@aSSm=J$&*UPCeZLahM<0>t*O}Xq zKcM7R*|*3|zrIj~{6Q_RlDIJadg*t_AJXzsUn4jDD#a)5ZyWv3lAC^gl{)Pwjr>t^ z-LJY|;|un8mE2xXLazP1{+8b$|DM)g%)ICH>yhh_e_!jL@EN#y(P~dE{7+iGfPOpj zm(GCyS<6>E&b&EH+20!52l?N${ABv*$S)vvY~~$Fr7|CswIy0x)z9=|@G;O^+7c>` z(o*zq;D>riskO5OAC8UCh1JF4hHASzhpt5~<43B%p8Dmg*3JiCMm|c*A3NN#j%?NX zKkP<6TFZwFrfsEK{x;_9*r8f}a*FoHwLCc)`4}xP#fSBaSFN2NIvu&piKJ3|(#$hE zhu)0*FeSE1pCTWm>iN)APnIUpA2H)#d-vGq+lJFl1eCusRPnU}8C+kLqV`9v)*n@z6cbmzujAfII9&Ey;P zcF%kfIenJYcK{3h!rPrQ|Bif$5?f_buIJUAE9W4`?^%%Az*~PcBT|KW>uay2u zJdjSgoI<_b>bj?qAFIT6-@BdH9b1bZ`8@KuN^bQpBG>a$^*DSfHc#sxil3NQ8!x{0 z8_18-@`=M~ryk$x6Bygrd|gk~v*h|U#?{CF0XaTLvZpX^Ccdg0WE?A$-0FWTxt^C6 z-`0a%{D9Q|5f-}s#Xl8&u@|ZTau#~tsIGnuxy<9F{y$@($EAAQ8srO=*jn{Iay^e# zS4#XY((=Ril5bW1v-m4E@=AV_pq3mva(j+tF&7M*ka@JHqbpvMNG0T1jOw-FPXPZv=nZGt diff --git a/collects/eopl/eopl-tool.ss b/collects/eopl/eopl-tool.ss index 4fb8761573..ef47bf5fef 100644 --- a/collects/eopl/eopl-tool.ss +++ b/collects/eopl/eopl-tool.ss @@ -9,7 +9,7 @@ wraps the load of the module.) |# (module eopl-tool mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "tool.ss" "drscheme") (lib "string-constant.ss" "string-constants")) @@ -17,9 +17,9 @@ wraps the load of the module.) (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define language-base% (class* object% (drscheme:language:simple-module-based-language<%>) (define/public (get-language-numbers) diff --git a/collects/errortrace/errortrace-lib.ss b/collects/errortrace/errortrace-lib.ss index 0263d49d1a..abb73d02c2 100644 --- a/collects/errortrace/errortrace-lib.ss +++ b/collects/errortrace/errortrace-lib.ss @@ -6,7 +6,7 @@ (require "stacktrace.ss" "errortrace-key.ss" (lib "list.ss") - (lib "unitsig.ss")) + (lib "unit.ss")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Test coverage run-time support @@ -122,8 +122,7 @@ loc expr))))) - (define-values/invoke-unit/sig - stacktrace^ stacktrace@ #f stacktrace-imports^) + (define-values/invoke-unit/infer stacktrace@) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Execute counts diff --git a/collects/errortrace/stacktrace.ss b/collects/errortrace/stacktrace.ss index 43c9900f70..8884e19d75 100644 --- a/collects/errortrace/stacktrace.ss +++ b/collects/errortrace/stacktrace.ss @@ -1,5 +1,5 @@ (module stacktrace mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "kerncase.ss" "syntax") (lib "stx.ss" "syntax")) @@ -25,10 +25,10 @@ st-mark-source st-mark-bindings)) - (define stacktrace@ - (unit/sig stacktrace^ - (import stacktrace-imports^) - + (define-unit stacktrace@ + (import stacktrace-imports^) + (export stacktrace^) + (define (short-version v depth) (cond [(identifier? v) (syntax-e v)] @@ -549,4 +549,4 @@ (define annotate (make-annotate #f #f)) (define annotate-top (make-annotate #t #f)) (define (annotate-named name expr trans?) - ((make-annotate #t name) expr trans?))))) + ((make-annotate #t name) expr trans?)))) diff --git a/collects/framework/framework-sig.ss b/collects/framework/framework-sig.ss index 1ddb27a8ad..749b47b9a5 100644 --- a/collects/framework/framework-sig.ss +++ b/collects/framework/framework-sig.ss @@ -1,63 +1,3 @@ (module framework-sig mzscheme - (require (lib "unitsig.ss") - "private/sig.ss") - - (provide framework^ framework-class^) - - (define-signature framework-class^ - ([unit application : framework:application-class^] - [unit version : framework:version-class^] - [unit color-model : framework:color-model-class^] - [unit exn : framework:exn-class^] - [unit exit : framework:exit-class^] - [unit preferences : framework:preferences-class^] - [unit number-snip : framework:number-snip-class^] - [unit autosave : framework:autosave-class^] - [unit handler : framework:handler-class^] - [unit keymap : framework:keymap-class^] - [unit path-utils : framework:path-utils-class^] - [unit icon : framework:icon-class^] - [unit editor : framework:editor-class^] - [unit pasteboard : framework:pasteboard-class^] - [unit text : framework:text-class^] - [unit finder : framework:finder-class^] - [unit group : framework:group-class^] - [unit canvas : framework:canvas-class^] - [unit panel : framework:panel-class^] - [unit menu : framework:menu-class^] - [unit frame : framework:frame-class^] - [unit color : framework:color-class^] - [unit color-prefs : framework:color-prefs-class^] - [unit scheme : framework:scheme-class^] - [unit comment-box : framework:comment-box-class^] - (unit mode : framework:mode-class^) - [unit main : framework:main-class^])) - - (define-signature framework^ - ([unit application : framework:application^] - [unit version : framework:version^] - [unit color-model : framework:color-model^] - [unit exn : framework:exn^] - [unit exit : framework:exit^] - [unit preferences : framework:preferences^] - [unit number-snip : framework:number-snip^] - [unit autosave : framework:autosave^] - [unit handler : framework:handler^] - [unit keymap : framework:keymap^] - [unit path-utils : framework:path-utils^] - [unit icon : framework:icon^] - [unit editor : framework:editor^] - [unit pasteboard : framework:pasteboard^] - [unit text : framework:text^] - [unit finder : framework:finder^] - [unit group : framework:group^] - [unit canvas : framework:canvas^] - [unit panel : framework:panel^] - [unit menu : framework:menu^] - [unit frame : framework:frame^] - [unit color : framework:color^] - [unit color-prefs : framework:color-prefs^] - [unit scheme : framework:scheme^] - [unit comment-box : framework:comment-box^] - (unit mode : framework:mode^) - [unit main : framework:main^]))) + (require "private/sig.ss") + (provide framework^)) \ No newline at end of file diff --git a/collects/framework/framework-unit.ss b/collects/framework/framework-unit.ss index f19caa06a0..8eb471437c 100644 --- a/collects/framework/framework-unit.ss +++ b/collects/framework/framework-unit.ss @@ -1,10 +1,8 @@ - (module framework-unit mzscheme - (require (lib "unitsig.ss") - (lib "mred-sig.ss" "mred")) + (require (lib "unit.ss") + (lib "mred-sig.ss" "mred")) - (require "framework-sig.ss" - "private/sig.ss" + (require "private/sig.ss" "private/number-snip.ss" "private/comment-box.ss" "private/application.ss" @@ -33,78 +31,69 @@ "private/main.ss" "private/mode.ss") - (provide framework@) + (provide framework-separate@ framework@) - (define framework@ - (compound-unit/sig - (import [mred : mred^]) - (link [application : framework:application^ (application@)] - [version : framework:version^ (version@)] - [color-model : framework:color-model^ (color-model@ )] - [exn : framework:exn^ (exn@)] - [mode : framework:mode^ (mode@)] - [exit : framework:exit^ (exit@ mred preferences)] - [menu : framework:menu^ (menu@ mred preferences)] - [preferences : framework:preferences^ (preferences@ mred exn exit panel frame)] - [number-snip : framework:number-snip^ (number-snip@ mred preferences)] - [autosave : framework:autosave^ (autosave@ mred exit preferences frame - scheme editor text finder group)] - [path-utils : framework:path-utils^ (path-utils@)] - [icon : framework:icon^ (icon@ mred)] - - [keymap : framework:keymap^ - (keymap@ mred preferences finder handler frame editor)] - [editor : framework:editor^ - (editor@ mred autosave finder path-utils keymap icon - preferences text pasteboard frame handler)] - [pasteboard : framework:pasteboard^ (pasteboard@ mred editor)] - [text : framework:text^ - (text@ mred icon editor preferences keymap - color-model frame scheme number-snip)] - [color : framework:color^ (color@ preferences icon mode text color-prefs scheme)] - [color-prefs : framework:color-prefs^ (color-prefs@ preferences editor panel canvas)] - [comment-box : framework:comment-box^ - (comment-box@ text scheme keymap)] - [finder : framework:finder^ (finder@ mred preferences keymap)] - [group : framework:group^ - (group@ mred application frame preferences text canvas menu)] - [canvas : framework:canvas^ (canvas@ mred preferences frame text)] - [panel : framework:panel^ (panel@ icon mred)] - [frame : framework:frame^ - (frame@ mred group preferences icon handler application panel - finder keymap text pasteboard editor canvas menu scheme exit - comment-box)] - [handler : framework:handler^ - (handler@ mred finder group text preferences frame)] - - [scheme : framework:scheme^ - (scheme@ mred preferences - icon keymap text editor frame comment-box mode color color-prefs)] - [main : framework:main^ (main@ mred preferences exit group handler editor color-prefs scheme)]) - (export (unit number-snip) - (unit menu) - (unit application) - (unit version) - (unit color-model) - (unit exn) - (unit exit) - (unit preferences) - (unit autosave) - (unit handler) - (unit keymap) - (unit path-utils) - (unit icon) - (unit editor) - (unit pasteboard) - (unit text) - (unit color) - (unit color-prefs) - (unit comment-box) - (unit finder) - (unit group) - (unit canvas) - (unit panel) - (unit frame) - (unit scheme) - (unit mode) - (unit main))))) + (define-compound-unit/infer framework-separate@ + (import mred^) + (export framework:application^ + framework:version^ + framework:color-model^ + framework:exn^ + framework:mode^ + framework:exit^ + framework:menu^ + framework:preferences^ + framework:number-snip^ + framework:autosave^ + framework:path-utils^ + framework:icon^ + framework:keymap^ + framework:editor^ + framework:pasteboard^ + framework:text^ + framework:color^ + framework:color-prefs^ + framework:comment-box^ + framework:finder^ + framework:group^ + framework:canvas^ + framework:panel^ + framework:frame^ + framework:handler^ + framework:scheme^ + framework:main^) + (link + application@ version@ color-model@ exn@ mode@ exit@ menu@ + preferences@ number-snip@ autosave@ path-utils@ icon@ keymap@ + editor@ pasteboard@ text@ color@ color-prefs@ comment-box@ + finder@ group@ canvas@ panel@ frame@ handler@ scheme@ main@)) + + (define-unit/new-import-export framework@ (import mred^) (export framework^) + (((prefix application: framework:application^) + (prefix version: framework:version^) + (prefix color-model: framework:color-model^) + (prefix exn: framework:exn^) + (prefix mode: framework:mode^) + (prefix exit: framework:exit^) + (prefix menu: framework:menu^) + (prefix preferences: framework:preferences^) + (prefix number-snip: framework:number-snip^) + (prefix autosave: framework:autosave^) + (prefix path-utils: framework:path-utils^) + (prefix icon: framework:icon^) + (prefix keymap: framework:keymap^) + (prefix editor: framework:editor^) + (prefix pasteboard: framework:pasteboard^) + (prefix text: framework:text^) + (prefix color: framework:color^) + (prefix color-prefs: framework:color-prefs^) + (prefix comment-box: framework:comment-box^) + (prefix finder: framework:finder^) + (prefix group: framework:group^) + (prefix canvas: framework:canvas^) + (prefix panel: framework:panel^) + (prefix frame: framework:frame^) + (prefix handler: framework:handler^) + (prefix scheme: framework:scheme^) + (prefix main: framework:main^)) + framework-separate@ mred^))) diff --git a/collects/framework/framework.ss b/collects/framework/framework.ss index 5650cab6f3..8e2b372fb3 100644 --- a/collects/framework/framework.ss +++ b/collects/framework/framework.ss @@ -1,8 +1,9 @@ (module framework mzscheme - (require (lib "unitsig.ss") - (lib "mred.ss" "mred") + (require (lib "unit.ss") + (lib "mred-unit.ss" "mred") (lib "mred-sig.ss" "mred") + (lib "mred.ss" "mred") (lib "class.ss") "test.ss" @@ -10,11 +11,38 @@ "decorated-editor-snip.ss" "framework-unit.ss" - "framework-sig.ss" + "private/sig.ss" (lib "contract.ss")) - (provide-signature-elements framework-class^) + (provide-signature-elements + (prefix application: framework:application-class^) + (prefix version: framework:version-class^) + (prefix color-model: framework:color-model-class^) + (prefix exn: framework:exn-class^) + (prefix mode: framework:mode-class^) + (prefix exit: framework:exit-class^) + (prefix menu: framework:menu-class^) + (prefix preferences: framework:preferences-class^) + (prefix number-snip: framework:number-snip-class^) + (prefix autosave: framework:autosave-class^) + (prefix path-utils: framework:path-utils-class^) + (prefix icon: framework:icon-class^) + (prefix keymap: framework:keymap-class^) + (prefix editor: framework:editor-class^) + (prefix pasteboard: framework:pasteboard-class^) + (prefix text: framework:text-class^) + (prefix color: framework:color-class^) + (prefix color-prefs: framework:color-prefs-class^) + (prefix comment-box: framework:comment-box-class^) + (prefix finder: framework:finder-class^) + (prefix group: framework:group-class^) + (prefix canvas: framework:canvas-class^) + (prefix panel: framework:panel-class^) + (prefix frame: framework:frame-class^) + (prefix handler: framework:handler-class^) + (prefix scheme: framework:scheme-class^) + (prefix main: framework:main-class^)) (provide (all-from "test.ss") (all-from "gui-utils.ss") @@ -27,13 +55,15 @@ (syntax-case stx () [(_ (name contract docs ...) ...) (syntax (provide/contract (name contract) ...))])) - - (define-values/invoke-unit/sig - framework^ - framework@ - #f - mred^) + + (define-compound-unit/infer framework+mred@ + (import) + (export framework^) + (link standard-mred@ framework@)) + + (define-values/invoke-unit/infer framework+mred@) + (provide/contract/docs (number-snip:make-repeating-decimal-snip diff --git a/collects/framework/private/application.ss b/collects/framework/private/application.ss index da32f122fc..ccad3e7ee6 100644 --- a/collects/framework/private/application.ss +++ b/collects/framework/private/application.ss @@ -1,18 +1,14 @@ -(module application mzscheme - (require (lib "unitsig.ss") - "sig.ss" - (lib "mred-sig.ss" "mred")) - - (provide application@) - - (define application@ - (unit/sig framework:application^ - (import) - - (define current-app-name (make-parameter - "MrEd" - (λ (x) - (unless (string? x) - (error 'current-app-name - "the app name must be a string")) - x)))))) \ No newline at end of file +(module application (lib "a-unit.ss") + (require "sig.ss") + + (import) + + (export framework:application^) + + (define current-app-name (make-parameter + "MrEd" + (λ (x) + (unless (string? x) + (error 'current-app-name + "the app name must be a string")) + x)))) \ No newline at end of file diff --git a/collects/framework/private/autosave.ss b/collects/framework/private/autosave.ss index 01513a1382..7aba4fdc50 100644 --- a/collects/framework/private/autosave.ss +++ b/collects/framework/private/autosave.ss @@ -1,29 +1,27 @@ -(module autosave mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module autosave (lib "a-unit.ss") + (require (lib "class.ss") (lib "file.ss") "sig.ss" "../gui-utils.ss" (lib "mred-sig.ss" "mred") (lib "mred.ss" "mred") ;; remove this! (lib "list.ss") - (lib "string-constant.ss" "string-constants")) - - (provide autosave@) + (lib "string-constant.ss" "string-constants") + (lib "unit.ss")) + + (import mred^ + [prefix exit: framework:exit^] + [prefix preferences: framework:preferences^] + [prefix frame: framework:frame^] + [prefix scheme: framework:scheme^] + [prefix editor: framework:editor^] + [prefix text: framework:text^] + [prefix finder: framework:finder^] + [prefix group: framework:group^]) + + (export framework:autosave^) - (define autosave@ - (unit/sig framework:autosave^ - (import mred^ - [exit : framework:exit^] - [preferences : framework:preferences^] - [frame : framework:frame^] - [scheme : framework:scheme^] - [editor : framework:editor^] - [text : framework:text^] - [finder : framework:finder^] - [group : framework:group^]) - (define autosavable<%> (interface () do-autosave)) @@ -316,4 +314,4 @@ (delete-file autosave-name) (when tmp-name (delete-file tmp-name)) - orig-name)))))))) + orig-name)))))) diff --git a/collects/framework/private/canvas.ss b/collects/framework/private/canvas.ss index 63800e7677..f3a1ed398d 100644 --- a/collects/framework/private/canvas.ss +++ b/collects/framework/private/canvas.ss @@ -1,19 +1,15 @@ -(module canvas mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module canvas (lib "a-unit.ss") + (require (lib "class.ss") "sig.ss" (lib "mred-sig.ss" "mred")) - (provide canvas@) + (import mred^ + [prefix preferences: framework:preferences^] + [prefix frame: framework:frame^] + [prefix text: framework:text^]) - (define canvas@ - (unit/sig framework:canvas^ - (import mred^ - [preferences : framework:preferences^] - [frame : framework:frame^] - [text : framework:text^]) - - (rename [-color% color%]) + (export (rename framework:canvas^ + (-color% color%))) (define basic<%> (interface ((class->interface editor-canvas%)))) (define basic-mixin @@ -182,4 +178,4 @@ (define -color% (color-mixin basic%)) (define info% (info-mixin basic%)) (define delegate% (delegate-mixin basic%)) - (define wide-snip% (wide-snip-mixin basic%))))) + (define wide-snip% (wide-snip-mixin basic%))) diff --git a/collects/framework/private/color-model.ss b/collects/framework/private/color-model.ss index df0d4ddd12..b38620f629 100644 --- a/collects/framework/private/color-model.ss +++ b/collects/framework/private/color-model.ss @@ -1,16 +1,11 @@ -(module color-model mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module color-model (lib "a-unit.ss") + (require (lib "class.ss") "sig.ss" (lib "mred-sig.ss" "mred") (lib "list.ss")) - (provide color-model@) - - (define color-model@ - (unit/sig framework:color-model^ - (import) - + (import) + (export framework:color-model^) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; ;;; matrix ops ;;; @@ -270,4 +265,4 @@ ;; (print-struct #t) ;; (xyz->luv (make-xyz 95.0 100.0 141.0)) ;; (xyz->luv (make-xyz 60.0 80.0 20.0)) - ))) \ No newline at end of file + ) \ No newline at end of file diff --git a/collects/framework/private/color-prefs.ss b/collects/framework/private/color-prefs.ss index 82525d2c3b..72e8e6cae4 100644 --- a/collects/framework/private/color-prefs.ss +++ b/collects/framework/private/color-prefs.ss @@ -1,303 +1,296 @@ - -(module color-prefs mzscheme +(module color-prefs (lib "a-unit.ss") (require (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "etc.ss") (lib "mred.ss" "mred") (lib "string-constant.ss" "string-constants") "sig.ss") - - (provide color-prefs@) - (define sc-choose-color (string-constant syntax-coloring-choose-color)) + (import [prefix preferences: framework:preferences^] + [prefix editor: framework:editor^] + [prefix panel: framework:panel^] + [prefix canvas: framework:canvas^]) + (export framework:color-prefs^) + (init-depend framework:editor^) - (define color-prefs@ - (unit/sig framework:color-prefs^ - (import [preferences : framework:preferences^] - [editor : framework:editor^] - [panel : framework:panel^] - [canvas : framework:canvas^]) + (define standard-style-list-text% (editor:standard-style-list-mixin text%)) + + ;; build-color-selection-panel : (is-a?/c area-container<%>) symbol string string -> void + ;; constructs a panel containg controls to configure the preferences panel. + ;; BUG: style changes don't update the check boxes. + (define build-color-selection-panel + (opt-lambda (parent + pref-sym + style-name + example-text + [update-style-delta + (λ (func) + (let ([delta (preferences:get pref-sym)]) + (func delta) + (preferences:set pref-sym delta)))]) + (define hp (new horizontal-panel% + (parent parent) + (style '(border)) + (stretchable-height #f))) + (define e (new (class standard-style-list-text% + (inherit change-style get-style-list) + (define/augment (after-insert pos offset) + (inner (void) after-insert pos offset) + (let ([style (send (get-style-list) + find-named-style + style-name)]) + (change-style style pos (+ pos offset) #f))) + (super-new)))) + (define c (new canvas:color% + (parent hp) + (editor e) + (style '(hide-hscroll + hide-vscroll)))) - (define standard-style-list-text% (editor:standard-style-list-mixin text%)) + (define (make-check name on off) + (let* ([c (λ (check command) + (if (send check get-value) + (update-style-delta on) + (update-style-delta off)))] + [check (make-object check-box% name hp c)]) + check)) - ;; build-color-selection-panel : (is-a?/c area-container<%>) symbol string string -> void - ;; constructs a panel containg controls to configure the preferences panel. - ;; BUG: style changes don't update the check boxes. - (define build-color-selection-panel - (opt-lambda (parent - pref-sym - style-name - example-text - [update-style-delta - (λ (func) - (let ([delta (preferences:get pref-sym)]) - (func delta) - (preferences:set pref-sym delta)))]) - (define hp (new horizontal-panel% - (parent parent) - (style '(border)) - (stretchable-height #f))) - (define e (new (class standard-style-list-text% - (inherit change-style get-style-list) - (define/augment (after-insert pos offset) - (inner (void) after-insert pos offset) - (let ([style (send (get-style-list) - find-named-style - style-name)]) - (change-style style pos (+ pos offset) #f))) - (super-new)))) - (define c (new canvas:color% - (parent hp) - (editor e) - (style '(hide-hscroll - hide-vscroll)))) - - (define (make-check name on off) - (let* ([c (λ (check command) - (if (send check get-value) - (update-style-delta on) - (update-style-delta off)))] - [check (make-object check-box% name hp c)]) - check)) - - (define slant-check - (make-check (string-constant cs-italic) - (λ (delta) - (send delta set-style-on 'slant) - (send delta set-style-off 'base)) - (λ (delta) - (send delta set-style-on 'base) - (send delta set-style-off 'slant)))) - (define bold-check - (make-check (string-constant cs-bold) - (λ (delta) - (send delta set-weight-on 'bold) - (send delta set-weight-off 'base)) - (λ (delta) - (send delta set-weight-on 'base) - (send delta set-weight-off 'bold)))) - (define underline-check - (make-check (string-constant cs-underline) - (λ (delta) - (send delta set-underlined-on #t) - (send delta set-underlined-off #f)) - (λ (delta) - (send delta set-underlined-off #t) - (send delta set-underlined-on #f)))) - (define color-button - (and (>= (get-display-depth) 8) - (make-object button% - (string-constant cs-change-color) - hp - (λ (color-button evt) - (let* ([add (send (preferences:get pref-sym) get-foreground-add)] - [color (make-object color% - (send add get-r) - (send add get-g) - (send add get-b))] - [users-choice - (get-color-from-user - (format sc-choose-color example-text) - (send color-button get-top-level-window) - color)]) - (when users-choice - (update-style-delta - (λ (delta) - (send delta set-delta-foreground users-choice))))))))) - (define style (send (send e get-style-list) find-named-style style-name)) - - (send c set-line-count 1) - (send c allow-tab-exit #t) - - (send e insert example-text) - (send e set-position 0) - - (send slant-check set-value (eq? (send style get-style) 'slant)) - (send bold-check set-value (eq? (send style get-weight) 'bold)) - (send underline-check set-value (send style get-underlined)))) + (define slant-check + (make-check (string-constant cs-italic) + (λ (delta) + (send delta set-style-on 'slant) + (send delta set-style-off 'base)) + (λ (delta) + (send delta set-style-on 'base) + (send delta set-style-off 'slant)))) + (define bold-check + (make-check (string-constant cs-bold) + (λ (delta) + (send delta set-weight-on 'bold) + (send delta set-weight-off 'base)) + (λ (delta) + (send delta set-weight-on 'base) + (send delta set-weight-off 'bold)))) + (define underline-check + (make-check (string-constant cs-underline) + (λ (delta) + (send delta set-underlined-on #t) + (send delta set-underlined-off #f)) + (λ (delta) + (send delta set-underlined-off #t) + (send delta set-underlined-on #f)))) + (define color-button + (and (>= (get-display-depth) 8) + (make-object button% + (string-constant cs-change-color) + hp + (λ (color-button evt) + (let* ([add (send (preferences:get pref-sym) get-foreground-add)] + [color (make-object color% + (send add get-r) + (send add get-g) + (send add get-b))] + [users-choice + (get-color-from-user + (format (string-constant syntax-coloring-choose-color) example-text) + (send color-button get-top-level-window) + color)]) + (when users-choice + (update-style-delta + (λ (delta) + (send delta set-delta-foreground users-choice))))))))) + (define style (send (send e get-style-list) find-named-style style-name)) - (define (add/mult-set m v) - (send m set (car v) (cadr v) (caddr v))) + (send c set-line-count 1) + (send c allow-tab-exit #t) - (define (add/mult-get m) - (let ([b1 (box 0)] - [b2 (box 0)] - [b3 (box 0)]) - (send m get b1 b2 b3) - (map unbox (list b1 b2 b3)))) + (send e insert example-text) + (send e set-position 0) - (define style-delta-get/set - (list (cons (λ (x) (send x get-alignment-off)) - (λ (x v) (send x set-alignment-off v))) - (cons (λ (x) (send x get-alignment-on)) - (λ (x v) (send x set-alignment-on v))) - (cons (λ (x) (add/mult-get (send x get-background-add))) - (λ (x v) (add/mult-set (send x get-background-add) v))) - (cons (λ (x) (add/mult-get (send x get-background-mult))) - (λ (x v) (add/mult-set (send x get-background-mult) v))) - (cons (λ (x) (send x get-face)) - (λ (x v) (send x set-face v))) - (cons (λ (x) (send x get-family)) - (λ (x v) (send x set-family v))) - (cons (λ (x) (add/mult-get (send x get-foreground-add))) - (λ (x v) (add/mult-set (send x get-foreground-add) v))) - (cons (λ (x) (add/mult-get (send x get-foreground-mult))) - (λ (x v) (add/mult-set (send x get-foreground-mult) v))) - (cons (λ (x) (send x get-size-add)) - (λ (x v) (send x set-size-add v))) - (cons (λ (x) (send x get-size-mult)) - (λ (x v) (send x set-size-mult v))) - (cons (λ (x) (send x get-style-off)) - (λ (x v) (send x set-style-off v))) - (cons (λ (x) (send x get-style-on)) - (λ (x v) (send x set-style-on v))) - (cons (λ (x) (send x get-underlined-off)) - (λ (x v) (send x set-underlined-off v))) - (cons (λ (x) (send x get-underlined-on)) - (λ (x v) (send x set-underlined-on v))) - (cons (λ (x) (send x get-weight-off)) - (λ (x v) (send x set-weight-off v))) - (cons (λ (x) (send x get-weight-on)) - (λ (x v) (send x set-weight-on v))))) - - (define (marshall-style style) - (map (λ (fs) ((car fs) style)) style-delta-get/set)) - - (define (unmarshall-style info) - (let ([style (make-object style-delta%)]) - (for-each (λ (fs v) ((cdr fs) style v)) style-delta-get/set info) - style)) - - (define (make-style-delta color bold? underline? italic?) - (let ((sd (make-object style-delta%))) - (send sd set-delta-foreground color) - (cond - (bold? - (send sd set-weight-on 'bold) - (send sd set-weight-off 'base)) - (else - (send sd set-weight-on 'base) - (send sd set-weight-off 'bold))) - (send sd set-underlined-on underline?) - (send sd set-underlined-off (not underline?)) - (cond - (italic? - (send sd set-style-on 'italic) - (send sd set-style-off 'base)) - (else - (send sd set-style-on 'base) - (send sd set-style-off 'italic))) - sd)) - - (define (add-background-preferences-panel) - (preferences:add-panel - (list (string-constant preferences-colors) - (string-constant background-color)) - (λ (parent) - (let ([vp (new vertical-panel% (parent parent))]) - (add-solid-color-config (string-constant background-color) - vp - 'framework:basic-canvas-background) - (add-solid-color-config (string-constant paren-match-color) - vp - 'framework:paren-match-color) - (build-text-foreground-selection-panel vp - 'framework:default-text-color - (editor:get-default-color-style-name) - (string-constant default-text-color)))))) - - (define (build-text-foreground-selection-panel parent pref-sym style-name example-text) - (define hp (new horizontal-panel% - (parent parent) - (style '(border)) - (stretchable-height #f))) - (define e (new (class standard-style-list-text% - (inherit change-style get-style-list) - (define/augment (after-insert pos offset) - (inner (void) after-insert pos offset) - (let ([style (send (get-style-list) - find-named-style - style-name)]) - (change-style style pos (+ pos offset) #f))) - (super-new)))) - (define c (new canvas:color% - (parent hp) - (editor e) - (style '(hide-hscroll - hide-vscroll)))) - (define color-button - (and (>= (get-display-depth) 8) - (make-object button% - (string-constant cs-change-color) - hp - (λ (color-button evt) - (let ([users-choice - (get-color-from-user - (format sc-choose-color example-text) - (send color-button get-top-level-window) - (preferences:get pref-sym))]) - (when users-choice - (preferences:set pref-sym users-choice))))))) - (define style (send (send e get-style-list) find-named-style style-name)) - - (send c set-line-count 1) - (send c allow-tab-exit #t) - - (send e insert example-text) - (send e set-position 0)) - - (define (add-solid-color-config label parent pref-id) - (letrec ([panel (new vertical-panel% (parent parent) (stretchable-height #f))] - [hp (new horizontal-panel% (parent panel) (stretchable-height #f))] - [msg (new message% (parent hp) (label label))] - [canvas - (new canvas% - (parent hp) - (paint-callback - (λ (c dc) - (draw (preferences:get pref-id)))))] - [draw - (λ (clr) - (let ([dc (send canvas get-dc)]) - (let-values ([(w h) (send canvas get-client-size)]) - (send dc set-brush (send the-brush-list find-or-create-brush clr 'solid)) - (send dc set-pen (send the-pen-list find-or-create-pen clr 1 'solid)) - (send dc draw-rectangle 0 0 w h))))] - [button - (new button% - (label (string-constant cs-change-color)) - (parent hp) - (callback - (λ (x y) - (let ([color (get-color-from-user - (string-constant choose-a-background-color) - (send hp get-top-level-window) - (preferences:get pref-id))]) - (when color - (preferences:set pref-id color))))))]) - (preferences:add-callback - pref-id - (λ (p v) (draw v))) - panel)) - - ;; add-to-preferences-panel : string (vertical-panel -> void) -> void - (define (add-to-preferences-panel panel-name func) - (preferences:add-panel - (list (string-constant preferences-colors) panel-name) - (λ (parent) - (let ([panel (new vertical-panel% (parent parent))]) - (func panel) - panel)))) - - ;; see docs - (define (register-color-pref pref-name style-name color) - (let ([sd (new style-delta%)]) - (send sd set-delta-foreground color) - (preferences:set-default pref-name sd (λ (x) (is-a? x style-delta%)))) - (preferences:set-un/marshall pref-name marshall-style unmarshall-style) - (preferences:add-callback pref-name - (λ (sym v) - (editor:set-standard-style-list-delta style-name v))) - (editor:set-standard-style-list-delta style-name (preferences:get pref-name)))))) - - + (send slant-check set-value (eq? (send style get-style) 'slant)) + (send bold-check set-value (eq? (send style get-weight) 'bold)) + (send underline-check set-value (send style get-underlined)))) + + (define (add/mult-set m v) + (send m set (car v) (cadr v) (caddr v))) + + (define (add/mult-get m) + (let ([b1 (box 0)] + [b2 (box 0)] + [b3 (box 0)]) + (send m get b1 b2 b3) + (map unbox (list b1 b2 b3)))) + + (define style-delta-get/set + (list (cons (λ (x) (send x get-alignment-off)) + (λ (x v) (send x set-alignment-off v))) + (cons (λ (x) (send x get-alignment-on)) + (λ (x v) (send x set-alignment-on v))) + (cons (λ (x) (add/mult-get (send x get-background-add))) + (λ (x v) (add/mult-set (send x get-background-add) v))) + (cons (λ (x) (add/mult-get (send x get-background-mult))) + (λ (x v) (add/mult-set (send x get-background-mult) v))) + (cons (λ (x) (send x get-face)) + (λ (x v) (send x set-face v))) + (cons (λ (x) (send x get-family)) + (λ (x v) (send x set-family v))) + (cons (λ (x) (add/mult-get (send x get-foreground-add))) + (λ (x v) (add/mult-set (send x get-foreground-add) v))) + (cons (λ (x) (add/mult-get (send x get-foreground-mult))) + (λ (x v) (add/mult-set (send x get-foreground-mult) v))) + (cons (λ (x) (send x get-size-add)) + (λ (x v) (send x set-size-add v))) + (cons (λ (x) (send x get-size-mult)) + (λ (x v) (send x set-size-mult v))) + (cons (λ (x) (send x get-style-off)) + (λ (x v) (send x set-style-off v))) + (cons (λ (x) (send x get-style-on)) + (λ (x v) (send x set-style-on v))) + (cons (λ (x) (send x get-underlined-off)) + (λ (x v) (send x set-underlined-off v))) + (cons (λ (x) (send x get-underlined-on)) + (λ (x v) (send x set-underlined-on v))) + (cons (λ (x) (send x get-weight-off)) + (λ (x v) (send x set-weight-off v))) + (cons (λ (x) (send x get-weight-on)) + (λ (x v) (send x set-weight-on v))))) + + (define (marshall-style style) + (map (λ (fs) ((car fs) style)) style-delta-get/set)) + + (define (unmarshall-style info) + (let ([style (make-object style-delta%)]) + (for-each (λ (fs v) ((cdr fs) style v)) style-delta-get/set info) + style)) + + (define (make-style-delta color bold? underline? italic?) + (let ((sd (make-object style-delta%))) + (send sd set-delta-foreground color) + (cond + (bold? + (send sd set-weight-on 'bold) + (send sd set-weight-off 'base)) + (else + (send sd set-weight-on 'base) + (send sd set-weight-off 'bold))) + (send sd set-underlined-on underline?) + (send sd set-underlined-off (not underline?)) + (cond + (italic? + (send sd set-style-on 'italic) + (send sd set-style-off 'base)) + (else + (send sd set-style-on 'base) + (send sd set-style-off 'italic))) + sd)) + + (define (add-background-preferences-panel) + (preferences:add-panel + (list (string-constant preferences-colors) + (string-constant background-color)) + (λ (parent) + (let ([vp (new vertical-panel% (parent parent))]) + (add-solid-color-config (string-constant background-color) + vp + 'framework:basic-canvas-background) + (add-solid-color-config (string-constant paren-match-color) + vp + 'framework:paren-match-color) + (build-text-foreground-selection-panel vp + 'framework:default-text-color + (editor:get-default-color-style-name) + (string-constant default-text-color)))))) + + (define (build-text-foreground-selection-panel parent pref-sym style-name example-text) + (define hp (new horizontal-panel% + (parent parent) + (style '(border)) + (stretchable-height #f))) + (define e (new (class standard-style-list-text% + (inherit change-style get-style-list) + (define/augment (after-insert pos offset) + (inner (void) after-insert pos offset) + (let ([style (send (get-style-list) + find-named-style + style-name)]) + (change-style style pos (+ pos offset) #f))) + (super-new)))) + (define c (new canvas:color% + (parent hp) + (editor e) + (style '(hide-hscroll + hide-vscroll)))) + (define color-button + (and (>= (get-display-depth) 8) + (make-object button% + (string-constant cs-change-color) + hp + (λ (color-button evt) + (let ([users-choice + (get-color-from-user + (format (string-constant syntax-coloring-choose-color) example-text) + (send color-button get-top-level-window) + (preferences:get pref-sym))]) + (when users-choice + (preferences:set pref-sym users-choice))))))) + (define style (send (send e get-style-list) find-named-style style-name)) + + (send c set-line-count 1) + (send c allow-tab-exit #t) + + (send e insert example-text) + (send e set-position 0)) + + (define (add-solid-color-config label parent pref-id) + (letrec ([panel (new vertical-panel% (parent parent) (stretchable-height #f))] + [hp (new horizontal-panel% (parent panel) (stretchable-height #f))] + [msg (new message% (parent hp) (label label))] + [canvas + (new canvas% + (parent hp) + (paint-callback + (λ (c dc) + (draw (preferences:get pref-id)))))] + [draw + (λ (clr) + (let ([dc (send canvas get-dc)]) + (let-values ([(w h) (send canvas get-client-size)]) + (send dc set-brush (send the-brush-list find-or-create-brush clr 'solid)) + (send dc set-pen (send the-pen-list find-or-create-pen clr 1 'solid)) + (send dc draw-rectangle 0 0 w h))))] + [button + (new button% + (label (string-constant cs-change-color)) + (parent hp) + (callback + (λ (x y) + (let ([color (get-color-from-user + (string-constant choose-a-background-color) + (send hp get-top-level-window) + (preferences:get pref-id))]) + (when color + (preferences:set pref-id color))))))]) + (preferences:add-callback + pref-id + (λ (p v) (draw v))) + panel)) + + ;; add-to-preferences-panel : string (vertical-panel -> void) -> void + (define (add-to-preferences-panel panel-name func) + (preferences:add-panel + (list (string-constant preferences-colors) panel-name) + (λ (parent) + (let ([panel (new vertical-panel% (parent parent))]) + (func panel) + panel)))) + + ;; see docs + (define (register-color-pref pref-name style-name color) + (let ([sd (new style-delta%)]) + (send sd set-delta-foreground color) + (preferences:set-default pref-name sd (λ (x) (is-a? x style-delta%)))) + (preferences:set-un/marshall pref-name marshall-style unmarshall-style) + (preferences:add-callback pref-name + (λ (sym v) + (editor:set-standard-style-list-delta style-name v))) + (editor:set-standard-style-list-delta style-name (preferences:get pref-name)))) diff --git a/collects/framework/private/color.ss b/collects/framework/private/color.ss index 5cf75d86de..23d3ff1579 100644 --- a/collects/framework/private/color.ss +++ b/collects/framework/private/color.ss @@ -1,732 +1,728 @@ -(module color mzscheme +(module color (lib "a-unit.ss") (require (lib "class.ss") (lib "etc.ss") - (lib "unitsig.ss") (lib "thread.ss") (lib "mred.ss" "mred") (lib "token-tree.ss" "syntax-color") (lib "paren-tree.ss" "syntax-color") (lib "default-lexer.ss" "syntax-color") + (lib "unit.ss") "sig.ss") - - (define original-output-port (current-output-port)) - (define (oprintf . args) (apply fprintf original-output-port args)) + + (import [prefix preferences: framework:preferences^] + [prefix icon: framework:icon^] + [prefix mode: framework:mode^] + [prefix text: framework:text^] + [prefix color-prefs: framework:color-prefs^] + [prefix scheme: framework:scheme^]) + + (export (rename framework:color^ + (-text<%> text<%>) + (-text% text%) + (-text-mode<%> text-mode<%>))) + + (init-depend framework:text^ framework:mode^) - (provide color@) - (define (should-color-type? type) (not (memq type '(white-space no-color)))) - (define color@ - (unit/sig framework:color^ - (import [preferences : framework:preferences^] - [icon : framework:icon^] - [mode : framework:mode^] - [text : framework:text^] - [color-prefs : framework:color-prefs^] - [scheme : framework:scheme^]) - - (rename [-text<%> text<%>] - [-text% text%] - [-text-mode<%> text-mode<%>]) + (define -text<%> + (interface (text:basic<%>) + start-colorer + stop-colorer + force-stop-colorer - (define -text<%> - (interface (text:basic<%>) - start-colorer - stop-colorer - force-stop-colorer - - is-stopped? - is-frozen? - freeze-colorer - thaw-colorer - - reset-region - update-region-end - - skip-whitespace - backward-match - backward-containing-sexp - forward-match - insert-close-paren - classify-position)) - - (define text-mixin - (mixin (text:basic<%>) (-text<%>) - - ;; For profiling - (define timer #f) - - ;; ---------------------- Coloring modes ---------------------------- - - ;; The tokenizer is stopped. This is used by the surrogate to enter - ;; a mode with no coloring or paren matching. - (define stopped? #t) - - ;; The tokenizer is stopped and prevented from starting. This is - ;; an internal call for debugging. - (define force-stop? #f) - - ;; color-callback has been suspended because the text% became locked - ;; and should be requeued when the text% is unlocked. - (define restart-callback #f) - - ;; Some other tool wants to take over coloring the buffer, so the - ;; colorer shouldn't color anything. - (define frozen? #f) - ;; true iff the colorer must recolor from scratch when the freeze - ;; is over. - (define force-recolor-after-freeze #f) - - ;; ---------------------- Lexing state ------------------------------ - - ;; The tree of valid tokens, starting at start-pos - (define tokens (new token-tree%)) - - ;; If the tree is completed - (define up-to-date? #t) - (define/public (get-up-to-date?) up-to-date?) - - ;; The tree of tokens that have been invalidated by an edit - ;; but might still be valid. - (define invalid-tokens (new token-tree%)) - - ;; The position right before the invalid-tokens tree - (define invalid-tokens-start +inf.0) - - ;; The position right before the next token to be read - (define current-pos start-pos) - - ;; The lexer - (define get-token #f) - - ;; ---------------------- Parenethesis matching ---------------------- - - ;; The pairs of matching parens - (define pairs '()) - (define parens (new paren-tree% (matches pairs))) - - - ;; ---------------------- Interactions state ------------------------ - ;; The positions right before and right after the area to be tokenized - (define start-pos 0) - (define end-pos 'end) - - (inherit last-position) - - ;; See docs - (define/public (reset-region start end) - (unless (and (= start start-pos) (eqv? end end-pos)) - (unless (<= 0 start (last-position)) - (raise-mismatch-error 'reset-region - "start position not inside editor: " - start)) - (unless (or (eq? 'end end) (<= 0 end (last-position))) - (raise-mismatch-error 'reset-region - "end position not inside editor: " - end)) - (unless (or (eq? 'end end) (<= start end)) - (raise-mismatch-error 'reset-region - "end position before start position: " - (list end start))) - (set! start-pos start) - (set! end-pos end) - (reset-tokens) - (do-insert/delete start 0))) - - (define/public (get-region) (values start-pos end-pos)) - - ;; Modify the end of the region. - (define/public (update-region-end end) - (set! end-pos end)) - - ;; ---------------------- Preferences ------------------------------- - (define should-color? #t) - (define token-sym->style #f) - - ;; ---------------------- Multi-threading --------------------------- - ;; A list of thunks that color the buffer - (define colors null) - ;; The coroutine object for tokenizing the buffer - (define tok-cor #f) - ;; The editor revision when tok-cor was created - (define rev #f) - - - (inherit change-style begin-edit-sequence end-edit-sequence highlight-range - get-style-list in-edit-sequence? get-start-position get-end-position - local-edit-sequence? get-styles-fixed has-focus? - get-fixed-style) - - (define/private (reset-tokens) - (send tokens reset-tree) - (send invalid-tokens reset-tree) - (set! invalid-tokens-start +inf.0) - (set! up-to-date? #t) - (set! restart-callback #f) - (set! force-recolor-after-freeze #f) - (set! parens (new paren-tree% (matches pairs))) - (set! current-pos start-pos) - (set! colors null) + is-stopped? + is-frozen? + freeze-colorer + thaw-colorer + + reset-region + update-region-end + + skip-whitespace + backward-match + backward-containing-sexp + forward-match + insert-close-paren + classify-position)) + + (define text-mixin + (mixin (text:basic<%>) (-text<%>) + + ;; For profiling + (define timer #f) + + ;; ---------------------- Coloring modes ---------------------------- + + ;; The tokenizer is stopped. This is used by the surrogate to enter + ;; a mode with no coloring or paren matching. + (define stopped? #t) + + ;; The tokenizer is stopped and prevented from starting. This is + ;; an internal call for debugging. + (define force-stop? #f) + + ;; color-callback has been suspended because the text% became locked + ;; and should be requeued when the text% is unlocked. + (define restart-callback #f) + + ;; Some other tool wants to take over coloring the buffer, so the + ;; colorer shouldn't color anything. + (define frozen? #f) + ;; true iff the colorer must recolor from scratch when the freeze + ;; is over. + (define force-recolor-after-freeze #f) + + ;; ---------------------- Lexing state ------------------------------ + + ;; The tree of valid tokens, starting at start-pos + (define tokens (new token-tree%)) + + ;; If the tree is completed + (define up-to-date? #t) + (define/public (get-up-to-date?) up-to-date?) + + ;; The tree of tokens that have been invalidated by an edit + ;; but might still be valid. + (define invalid-tokens (new token-tree%)) + + ;; The position right before the invalid-tokens tree + (define invalid-tokens-start +inf.0) + + ;; The position right before the next token to be read + (define current-pos start-pos) + + ;; The lexer + (define get-token #f) + + ;; ---------------------- Parenethesis matching ---------------------- + + ;; The pairs of matching parens + (define pairs '()) + (define parens (new paren-tree% (matches pairs))) + + + ;; ---------------------- Interactions state ------------------------ + ;; The positions right before and right after the area to be tokenized + (define start-pos 0) + (define end-pos 'end) + + (inherit last-position) + + ;; See docs + (define/public (reset-region start end) + (unless (and (= start start-pos) (eqv? end end-pos)) + (unless (<= 0 start (last-position)) + (raise-mismatch-error 'reset-region + "start position not inside editor: " + start)) + (unless (or (eq? 'end end) (<= 0 end (last-position))) + (raise-mismatch-error 'reset-region + "end position not inside editor: " + end)) + (unless (or (eq? 'end end) (<= start end)) + (raise-mismatch-error 'reset-region + "end position before start position: " + (list end start))) + (set! start-pos start) + (set! end-pos end) + (reset-tokens) + (do-insert/delete start 0))) + + (define/public (get-region) (values start-pos end-pos)) + + ;; Modify the end of the region. + (define/public (update-region-end end) + (set! end-pos end)) + + ;; ---------------------- Preferences ------------------------------- + (define should-color? #t) + (define token-sym->style #f) + + ;; ---------------------- Multi-threading --------------------------- + ;; A list of thunks that color the buffer + (define colors null) + ;; The coroutine object for tokenizing the buffer + (define tok-cor #f) + ;; The editor revision when tok-cor was created + (define rev #f) + + + (inherit change-style begin-edit-sequence end-edit-sequence highlight-range + get-style-list in-edit-sequence? get-start-position get-end-position + local-edit-sequence? get-styles-fixed has-focus? + get-fixed-style) + + (define/private (reset-tokens) + (send tokens reset-tree) + (send invalid-tokens reset-tree) + (set! invalid-tokens-start +inf.0) + (set! up-to-date? #t) + (set! restart-callback #f) + (set! force-recolor-after-freeze #f) + (set! parens (new paren-tree% (matches pairs))) + (set! current-pos start-pos) + (set! colors null) + (when tok-cor + (coroutine-kill tok-cor)) + (set! tok-cor #f) + (set! rev #f)) + + ;; Actually color the buffer. + (define/private (color) + (unless (null? colors) + ((car colors)) + (set! colors (cdr colors)) + (color))) + + ;; Discard extra tokens at the first of invalid-tokens + (define/private (sync-invalid) + (when (and (not (send invalid-tokens is-empty?)) + (< invalid-tokens-start current-pos)) + (send invalid-tokens search-min!) + (let ((length (send invalid-tokens get-root-length))) + (send invalid-tokens remove-root!) + (set! invalid-tokens-start (+ invalid-tokens-start length))) + (sync-invalid))) + + (define/private (re-tokenize in in-start-pos enable-suspend) + (let-values ([(lexeme type data new-token-start new-token-end) + (get-token in)]) + (unless (eq? 'eof type) + (enable-suspend #f) + #;(printf "~a at ~a to ~a~n" lexeme (+ in-start-pos (sub1 new-token-start)) + (+ in-start-pos (sub1 new-token-end))) + (let ((len (- new-token-end new-token-start))) + (set! current-pos (+ len current-pos)) + (sync-invalid) + (when (and should-color? (should-color-type? type) (not frozen?)) + (set! colors + (cons + (let* ([style-name (token-sym->style type)] + (color (send (get-style-list) find-named-style style-name)) + (sp (+ in-start-pos (sub1 new-token-start))) + (ep (+ in-start-pos (sub1 new-token-end)))) + (λ () + (change-style color sp ep #f))) + colors))) + ; Using the non-spec version takes 3 times as long as the spec + ; version. In other words, the new greatly outweighs the tree + ; operations. + ;(insert-last! tokens (new token-tree% (length len) (data type))) + (insert-last-spec! tokens len type) + (send parens add-token data len) + (cond + ((and (not (send invalid-tokens is-empty?)) + (= invalid-tokens-start current-pos)) + (send invalid-tokens search-max!) + (send parens merge-tree + (send invalid-tokens get-root-end-position)) + (insert-last! tokens invalid-tokens) + (set! invalid-tokens-start +inf.0) + (enable-suspend #t)) + (else + (enable-suspend #t) + (re-tokenize in in-start-pos enable-suspend))))))) + + (define/private (do-insert/delete edit-start-pos change-length) + (unless (or stopped? force-stop?) + (unless up-to-date? + (sync-invalid)) + (cond + (up-to-date? + (let-values + (((orig-token-start orig-token-end valid-tree invalid-tree) + (send tokens split (- edit-start-pos start-pos)))) + (send parens split-tree orig-token-start) + (set! invalid-tokens invalid-tree) + (set! tokens valid-tree) + (set! invalid-tokens-start + (if (send invalid-tokens is-empty?) + +inf.0 + (+ start-pos orig-token-end change-length))) + (set! current-pos (+ start-pos orig-token-start)) + (set! up-to-date? #f) + (queue-callback (λ () (colorer-callback)) #f))) + ((>= edit-start-pos invalid-tokens-start) + (let-values (((tok-start tok-end valid-tree invalid-tree) + (send invalid-tokens split (- edit-start-pos start-pos)))) + (set! invalid-tokens invalid-tree) + (set! invalid-tokens-start + (+ invalid-tokens-start tok-end change-length)))) + ((> edit-start-pos current-pos) + (set! invalid-tokens-start (+ change-length invalid-tokens-start))) + (else + (let-values (((tok-start tok-end valid-tree invalid-tree) + (send tokens split (- edit-start-pos start-pos)))) + (send parens truncate tok-start) + (set! tokens valid-tree) + (set! invalid-tokens-start (+ change-length invalid-tokens-start)) + (set! current-pos (+ start-pos tok-start))))))) + + (inherit is-locked? get-revision-number) + + (define/private (colorer-driver) + (unless up-to-date? + #;(printf "revision ~a~n" (get-revision-number)) + (unless (and tok-cor (= rev (get-revision-number))) (when tok-cor (coroutine-kill tok-cor)) - (set! tok-cor #f) - (set! rev #f)) - - ;; Actually color the buffer. - (define/private (color) - (unless (null? colors) - ((car colors)) - (set! colors (cdr colors)) - (color))) - - ;; Discard extra tokens at the first of invalid-tokens - (define/private (sync-invalid) - (when (and (not (send invalid-tokens is-empty?)) - (< invalid-tokens-start current-pos)) - (send invalid-tokens search-min!) - (let ((length (send invalid-tokens get-root-length))) - (send invalid-tokens remove-root!) - (set! invalid-tokens-start (+ invalid-tokens-start length))) - (sync-invalid))) - - (define/private (re-tokenize in in-start-pos enable-suspend) - (let-values ([(lexeme type data new-token-start new-token-end) - (get-token in)]) - (unless (eq? 'eof type) - (enable-suspend #f) - #;(printf "~a at ~a to ~a~n" lexeme (+ in-start-pos (sub1 new-token-start)) - (+ in-start-pos (sub1 new-token-end))) - (let ((len (- new-token-end new-token-start))) - (set! current-pos (+ len current-pos)) - (sync-invalid) - (when (and should-color? (should-color-type? type) (not frozen?)) - (set! colors - (cons - (let* ([style-name (token-sym->style type)] - (color (send (get-style-list) find-named-style style-name)) - (sp (+ in-start-pos (sub1 new-token-start))) - (ep (+ in-start-pos (sub1 new-token-end)))) - (λ () - (change-style color sp ep #f))) - colors))) - ; Using the non-spec version takes 3 times as long as the spec - ; version. In other words, the new greatly outweighs the tree - ; operations. - ;(insert-last! tokens (new token-tree% (length len) (data type))) - (insert-last-spec! tokens len type) - (send parens add-token data len) - (cond - ((and (not (send invalid-tokens is-empty?)) - (= invalid-tokens-start current-pos)) - (send invalid-tokens search-max!) - (send parens merge-tree - (send invalid-tokens get-root-end-position)) - (insert-last! tokens invalid-tokens) - (set! invalid-tokens-start +inf.0) - (enable-suspend #t)) - (else - (enable-suspend #t) - (re-tokenize in in-start-pos enable-suspend))))))) - - (define/private (do-insert/delete edit-start-pos change-length) - (unless (or stopped? force-stop?) - (unless up-to-date? - (sync-invalid)) - (cond - (up-to-date? - (let-values - (((orig-token-start orig-token-end valid-tree invalid-tree) - (send tokens split (- edit-start-pos start-pos)))) - (send parens split-tree orig-token-start) - (set! invalid-tokens invalid-tree) - (set! tokens valid-tree) - (set! invalid-tokens-start - (if (send invalid-tokens is-empty?) - +inf.0 - (+ start-pos orig-token-end change-length))) - (set! current-pos (+ start-pos orig-token-start)) - (set! up-to-date? #f) - (queue-callback (λ () (colorer-callback)) #f))) - ((>= edit-start-pos invalid-tokens-start) - (let-values (((tok-start tok-end valid-tree invalid-tree) - (send invalid-tokens split (- edit-start-pos start-pos)))) - (set! invalid-tokens invalid-tree) - (set! invalid-tokens-start - (+ invalid-tokens-start tok-end change-length)))) - ((> edit-start-pos current-pos) - (set! invalid-tokens-start (+ change-length invalid-tokens-start))) - (else - (let-values (((tok-start tok-end valid-tree invalid-tree) - (send tokens split (- edit-start-pos start-pos)))) - (send parens truncate tok-start) - (set! tokens valid-tree) - (set! invalid-tokens-start (+ change-length invalid-tokens-start)) - (set! current-pos (+ start-pos tok-start))))))) - - (inherit is-locked? get-revision-number) - - (define/private (colorer-driver) + #;(printf "new coroutine~n") + (set! tok-cor + (coroutine + (λ (enable-suspend) + (parameterize ((port-count-lines-enabled #t)) + (re-tokenize (open-input-text-editor this current-pos end-pos + (λ (x) #f)) + current-pos + enable-suspend))))) + (set! rev (get-revision-number))) + (with-handlers ((exn:fail? + (λ (exn) + (parameterize ((print-struct #t)) + ((error-display-handler) + (format "exception in colorer thread: ~s" exn) + exn)) + (set! tok-cor #f)))) + #;(printf "begin lexing~n") + (when (coroutine-run 10 tok-cor) + (set! up-to-date? #t))) + #;(printf "end lexing~n") + #;(printf "begin coloring~n") + ;; This edit sequence needs to happen even when colors is null + ;; for the paren highlighter. + (begin-edit-sequence #f #f) + (color) + (end-edit-sequence) + #;(printf "end coloring~n"))) + + (define/private (colorer-callback) + (cond + ((is-locked?) + (set! restart-callback #t)) + (else + (unless (in-edit-sequence?) + (colorer-driver)) + (unless up-to-date? + (queue-callback (λ () (colorer-callback)) #f))))) + + ;; Must not be called when the editor is locked + (define/private (finish-now) + (unless stopped? + (let loop () (unless up-to-date? - #;(printf "revision ~a~n" (get-revision-number)) - (unless (and tok-cor (= rev (get-revision-number))) - (when tok-cor - (coroutine-kill tok-cor)) - #;(printf "new coroutine~n") - (set! tok-cor - (coroutine - (λ (enable-suspend) - (parameterize ((port-count-lines-enabled #t)) - (re-tokenize (open-input-text-editor this current-pos end-pos - (λ (x) #f)) - current-pos - enable-suspend))))) - (set! rev (get-revision-number))) - (with-handlers ((exn:fail? - (λ (exn) - (parameterize ((print-struct #t)) - ((error-display-handler) - (format "exception in colorer thread: ~s" exn) - exn)) - (set! tok-cor #f)))) - #;(printf "begin lexing~n") - (when (coroutine-run 10 tok-cor) - (set! up-to-date? #t))) - #;(printf "end lexing~n") - #;(printf "begin coloring~n") - ;; This edit sequence needs to happen even when colors is null - ;; for the paren highlighter. - (begin-edit-sequence #f #f) - (color) - (end-edit-sequence) - #;(printf "end coloring~n"))) - - (define/private (colorer-callback) - (cond - ((is-locked?) - (set! restart-callback #t)) - (else - (unless (in-edit-sequence?) - (colorer-driver)) - (unless up-to-date? - (queue-callback (λ () (colorer-callback)) #f))))) - - ;; Must not be called when the editor is locked - (define/private (finish-now) - (unless stopped? - (let loop () - (unless up-to-date? - (colorer-driver) - (loop))))) - - ;; See docs - (define/public (start-colorer token-sym->style- get-token- pairs-) - (unless force-stop? - (set! stopped? #f) - (reset-tokens) - (set! should-color? (preferences:get 'framework:coloring-active)) - (set! token-sym->style token-sym->style-) - (set! get-token get-token-) - (set! pairs pairs-) - (set! parens (new paren-tree% (matches pairs))) - ;; (set! timer (current-milliseconds)) - (do-insert/delete start-pos 0))) - - ;; See docs - (define/public stop-colorer - (opt-lambda ((clear-colors #t)) - (set! stopped? #t) - (when (and clear-colors (not frozen?)) - (begin-edit-sequence #f #f) - (change-style (get-fixed-style) start-pos end-pos #f) - (end-edit-sequence)) - (match-parens #t) - (reset-tokens) - (set! pairs null) - (set! token-sym->style #f) - (set! get-token #f))) - - (define/public (is-frozen?) frozen?) - (define/public (is-stopped?) stopped?) - - ;; See docs - (define/public (freeze-colorer) - (when (is-locked?) - (error 'freeze-colorer "called on a locked color:text<%>.")) - (unless frozen? - (finish-now) - (set! frozen? #t))) - - ;; See docs - (define/public thaw-colorer - (opt-lambda ((recolor? #t) - (retokenize? #f)) - (when frozen? - (set! frozen? #f) - (cond - (stopped? - (stop-colorer)) - ((or force-recolor-after-freeze recolor?) - (cond - (retokenize? - (let ((tn token-sym->style) - (gt get-token) - (p pairs)) - (stop-colorer (not should-color?)) - (start-colorer tn gt p))) - (else - (begin-edit-sequence #f #f) - (finish-now) - (send tokens for-each - (λ (start len type) - (when (and should-color? (should-color-type? type)) - (let ((color (send (get-style-list) find-named-style - (token-sym->style type))) - (sp (+ start-pos start)) - (ep (+ start-pos (+ start len)))) - (change-style color sp ep #f))))) - (end-edit-sequence)))))))) - - - (define/private (toggle-color on?) - (cond - ((and frozen? (not (equal? on? should-color?))) - (set! should-color? on?) - (set! force-recolor-after-freeze #t)) - ((and (not should-color?) on?) - (set! should-color? on?) - (reset-tokens) - (do-insert/delete start-pos 0)) - ((and should-color? (not on?)) - (set! should-color? on?) - (begin-edit-sequence #f #f) - (change-style (get-fixed-style) start-pos end-pos #f) - (end-edit-sequence)))) - - ;; see docs - (define/public (force-stop-colorer stop?) - (set! force-stop? stop?) - (when stop? - (stop-colorer))) - - - ;; ----------------------- Match parentheses ---------------------------- - - (define clear-old-locations void) - - (define mismatch-color (make-object color% "PINK")) - (define/private (get-match-color) (preferences:get 'framework:paren-match-color)) - - (define/private (highlight start end caret-pos error?) - (let ([off (highlight-range (+ start-pos start) (+ start-pos end) - (if error? mismatch-color (get-match-color)) - (and (send (icon:get-paren-highlight-bitmap) - ok?) - (icon:get-paren-highlight-bitmap)) - (= caret-pos (+ start-pos start)))]) - (set! clear-old-locations - (let ([old clear-old-locations]) - (λ () - (old) - (off)))))) - - (define in-match-parens? #f) - - ;; the forward matcher signaled an error because not enough of the - ;; tree has been built. - (define/private (f-match-false-error start end error) - (and error (<= (+ start-pos error) current-pos) (not up-to-date?))) - - - ;; If there is no match because the buffer isn't lexed far enough yet, - ;; this will do nothing, but the edit sequence for changing the colors - ;; will trigger a callback that will call this to try and match again. - ;; This edit sequence is used even if the coloring is disabled in - ;; the preferences, although nothing is actually colored during it. - ;; This leads to the nice behavior that we don't have to block to - ;; highlight parens, and the parens will be highlighted as soon as - ;; possible. - (define/private match-parens - (opt-lambda ([just-clear? #f]) - ;;(printf "(match-parens ~a)~n" just-clear?) - (when (and (not in-match-parens?) - ;; Trying to match open parens while the - ;; background thread is going slows it down. - ;; The random number slows down how often it - ;; tries. - (or just-clear? up-to-date? (= 0 (random 5)))) - (set! in-match-parens? #t) - (begin-edit-sequence #f #f) - (clear-old-locations) - (set! clear-old-locations void) - (when (and (preferences:get 'framework:highlight-parens) - (not just-clear?)) - (let* ((here (get-start-position))) - (when (= here (get-end-position)) - (let-values (((start-f end-f error-f) - (send parens match-forward (- here start-pos)))) - (when (and (not (f-match-false-error start-f end-f error-f)) - start-f end-f) - (highlight start-f end-f here error-f))) - (let-values (((start-b end-b error-b) - (send parens match-backward (- here start-pos)))) - (when (and start-b end-b) - (highlight start-b end-b here error-b)))))) - (end-edit-sequence) - (set! in-match-parens? #f)))) - - ;; See docs - (define/public (forward-match position cutoff) - (do-forward-match position cutoff #t)) - - (define/private (do-forward-match position cutoff skip-whitespace?) - (let ((position - (if skip-whitespace? - (skip-whitespace position 'forward #t) - position))) - (let-values (((start end error) - (send parens match-forward (- position start-pos)))) - (cond - ((f-match-false-error start end error) - (colorer-driver) - (do-forward-match position cutoff #f)) - ((and start end (not error)) - (let ((match-pos (+ start-pos end))) - (cond - ((<= match-pos cutoff) match-pos) - (else #f)))) - ((and start end error) #f) - (else - (let-values (((tok-start tok-end) - (begin - (tokenize-to-pos position) - (send tokens search! (- position start-pos)) - (values (send tokens get-root-start-position) - (send tokens get-root-end-position))))) - (cond - ((or (send parens is-close-pos? tok-start) - (= (+ start-pos tok-end) position)) - #f) - (else - (+ start-pos tok-end))))))))) - - - ;; See docs - (define/public (backward-match position cutoff) - (let ((x (internal-backward-match position cutoff))) - (cond - ((eq? x 'open) #f) - (else x)))) - - (define/private (internal-backward-match position cutoff) - (when stopped? - (error 'backward-match "called on a color:text<%> whose colorer is stopped.")) - (let ((position (skip-whitespace position 'backward #t))) - (let-values (((start end error) - (send parens match-backward (- position start-pos)))) - (cond - ((and start end (not error)) - (let ((match-pos (+ start-pos start))) - (cond - ((>= match-pos cutoff) match-pos) - (else #f)))) - ((and start end error) #f) - (else - (let-values (((tok-start tok-end) - (begin - (send tokens search! - (if (> position start-pos) - (- position start-pos 1) - 0)) - (values (send tokens get-root-start-position) - (send tokens get-root-end-position))))) - (cond - ((or (send parens is-open-pos? tok-start) - (= (+ start-pos tok-start) position)) - 'open) - (else - (+ start-pos tok-start))))))))) - - ;; See docs - (define/public (backward-containing-sexp position cutoff) - (when stopped? - (error 'backward-containing-sexp "called on a color:text<%> whose colorer is stopped.")) - (let loop ((cur-pos position)) - (let ((p (internal-backward-match cur-pos cutoff))) - (cond - ((eq? 'open p) cur-pos) - ((not p) #f) - (else (loop p)))))) - - ;; Determines whether a position is a 'comment, 'string, etc. - (define/public (classify-position position) - (when stopped? - (error 'classify-position "called on a color:text<%> whose colorer is stopped.")) - (tokenize-to-pos position) - (send tokens search! (- position start-pos)) - (send tokens get-root-data)) - - (define/private (tokenize-to-pos position) - (when (and (not up-to-date?) (<= current-pos position)) (colorer-driver) - (tokenize-to-pos position))) - - ;; See docs - (define/public (skip-whitespace position direction comments?) - (when stopped? - (error 'skip-whitespace "called on a color:text<%> whose colorer is stopped.")) + (loop))))) + + ;; See docs + (define/public (start-colorer token-sym->style- get-token- pairs-) + (unless force-stop? + (set! stopped? #f) + (reset-tokens) + (set! should-color? (preferences:get 'framework:coloring-active)) + (set! token-sym->style token-sym->style-) + (set! get-token get-token-) + (set! pairs pairs-) + (set! parens (new paren-tree% (matches pairs))) + ;; (set! timer (current-milliseconds)) + (do-insert/delete start-pos 0))) + + ;; See docs + (define/public stop-colorer + (opt-lambda ((clear-colors #t)) + (set! stopped? #t) + (when (and clear-colors (not frozen?)) + (begin-edit-sequence #f #f) + (change-style (get-fixed-style) start-pos end-pos #f) + (end-edit-sequence)) + (match-parens #t) + (reset-tokens) + (set! pairs null) + (set! token-sym->style #f) + (set! get-token #f))) + + (define/public (is-frozen?) frozen?) + (define/public (is-stopped?) stopped?) + + ;; See docs + (define/public (freeze-colorer) + (when (is-locked?) + (error 'freeze-colorer "called on a locked color:text<%>.")) + (unless frozen? + (finish-now) + (set! frozen? #t))) + + ;; See docs + (define/public thaw-colorer + (opt-lambda ((recolor? #t) + (retokenize? #f)) + (when frozen? + (set! frozen? #f) (cond - ((and (eq? direction 'forward) - (>= position (if (eq? 'end end-pos) (last-position) end-pos))) - position) - ((and (eq? direction 'backward) (<= position start-pos)) - position) - (else - (tokenize-to-pos position) - (send tokens search! (- (if (eq? direction 'backward) (sub1 position) position) - start-pos)) + (stopped? + (stop-colorer)) + ((or force-recolor-after-freeze recolor?) + (cond + (retokenize? + (let ((tn token-sym->style) + (gt get-token) + (p pairs)) + (stop-colorer (not should-color?)) + (start-colorer tn gt p))) + (else + (begin-edit-sequence #f #f) + (finish-now) + (send tokens for-each + (λ (start len type) + (when (and should-color? (should-color-type? type)) + (let ((color (send (get-style-list) find-named-style + (token-sym->style type))) + (sp (+ start-pos start)) + (ep (+ start-pos (+ start len)))) + (change-style color sp ep #f))))) + (end-edit-sequence)))))))) + + + (define/private (toggle-color on?) + (cond + ((and frozen? (not (equal? on? should-color?))) + (set! should-color? on?) + (set! force-recolor-after-freeze #t)) + ((and (not should-color?) on?) + (set! should-color? on?) + (reset-tokens) + (do-insert/delete start-pos 0)) + ((and should-color? (not on?)) + (set! should-color? on?) + (begin-edit-sequence #f #f) + (change-style (get-fixed-style) start-pos end-pos #f) + (end-edit-sequence)))) + + ;; see docs + (define/public (force-stop-colorer stop?) + (set! force-stop? stop?) + (when stop? + (stop-colorer))) + + + ;; ----------------------- Match parentheses ---------------------------- + + (define clear-old-locations void) + + (define mismatch-color (make-object color% "PINK")) + (define/private (get-match-color) (preferences:get 'framework:paren-match-color)) + + (define/private (highlight start end caret-pos error?) + (let ([off (highlight-range (+ start-pos start) (+ start-pos end) + (if error? mismatch-color (get-match-color)) + (and (send (icon:get-paren-highlight-bitmap) + ok?) + (icon:get-paren-highlight-bitmap)) + (= caret-pos (+ start-pos start)))]) + (set! clear-old-locations + (let ([old clear-old-locations]) + (λ () + (old) + (off)))))) + + (define in-match-parens? #f) + + ;; the forward matcher signaled an error because not enough of the + ;; tree has been built. + (define/private (f-match-false-error start end error) + (and error (<= (+ start-pos error) current-pos) (not up-to-date?))) + + + ;; If there is no match because the buffer isn't lexed far enough yet, + ;; this will do nothing, but the edit sequence for changing the colors + ;; will trigger a callback that will call this to try and match again. + ;; This edit sequence is used even if the coloring is disabled in + ;; the preferences, although nothing is actually colored during it. + ;; This leads to the nice behavior that we don't have to block to + ;; highlight parens, and the parens will be highlighted as soon as + ;; possible. + (define/private match-parens + (opt-lambda ([just-clear? #f]) + ;;(printf "(match-parens ~a)~n" just-clear?) + (when (and (not in-match-parens?) + ;; Trying to match open parens while the + ;; background thread is going slows it down. + ;; The random number slows down how often it + ;; tries. + (or just-clear? up-to-date? (= 0 (random 5)))) + (set! in-match-parens? #t) + (begin-edit-sequence #f #f) + (clear-old-locations) + (set! clear-old-locations void) + (when (and (preferences:get 'framework:highlight-parens) + (not just-clear?)) + (let* ((here (get-start-position))) + (when (= here (get-end-position)) + (let-values (((start-f end-f error-f) + (send parens match-forward (- here start-pos)))) + (when (and (not (f-match-false-error start-f end-f error-f)) + start-f end-f) + (highlight start-f end-f here error-f))) + (let-values (((start-b end-b error-b) + (send parens match-backward (- here start-pos)))) + (when (and start-b end-b) + (highlight start-b end-b here error-b)))))) + (end-edit-sequence) + (set! in-match-parens? #f)))) + + ;; See docs + (define/public (forward-match position cutoff) + (do-forward-match position cutoff #t)) + + (define/private (do-forward-match position cutoff skip-whitespace?) + (let ((position + (if skip-whitespace? + (skip-whitespace position 'forward #t) + position))) + (let-values (((start end error) + (send parens match-forward (- position start-pos)))) + (cond + ((f-match-false-error start end error) + (colorer-driver) + (do-forward-match position cutoff #f)) + ((and start end (not error)) + (let ((match-pos (+ start-pos end))) (cond - ((or (eq? 'white-space (send tokens get-root-data)) - (and comments? (eq? 'comment (send tokens get-root-data)))) - (skip-whitespace (+ start-pos - (if (eq? direction 'forward) - (send tokens get-root-end-position) - (send tokens get-root-start-position))) - direction - comments?)) - (else position))))) - - (define/private (get-close-paren pos closers) - (cond - ((null? closers) #f) + ((<= match-pos cutoff) match-pos) + (else #f)))) + ((and start end error) #f) (else - (let* ((c (car closers)) - (l (string-length c))) - (insert c pos) - (let ((m (backward-match (+ l pos) start-pos))) - (cond - ((and m - (send parens is-open-pos? (- m start-pos)) - (send parens is-close-pos? (- pos start-pos))) - (delete pos (+ l pos)) - c) - (else - (delete pos (+ l pos)) - (get-close-paren pos (cdr closers))))))))) - - (inherit insert delete flash-on on-default-char) - ;; See docs - (define/public (insert-close-paren pos char flash? fixup?) - (let ((closer - (begin - (begin-edit-sequence #f #f) - (get-close-paren pos (if fixup? (map symbol->string (map cadr pairs)) null))))) - (end-edit-sequence) - (let ((insert-str (if closer closer (string char)))) - (for-each (lambda (c) - (on-default-char (new key-event% (key-code c)))) - (string->list insert-str)) - (when flash? - (unless stopped? - (let ((to-pos (backward-match (+ (string-length insert-str) pos) 0))) - (when (and to-pos - (send parens is-open-pos? (- to-pos start-pos)) - (send parens is-close-pos? (- pos start-pos))) - (flash-on to-pos (+ 1 to-pos))))))))) - - (define/public (debug-printout) - (let* ((x null) - (f (λ (a b c) (set! x (cons (list a b c) x))))) - (send tokens for-each f) - (printf "tokens: ~e~n" (reverse x)) - (set! x null) - (send invalid-tokens for-each f) - (printf "invalid-tokens: ~e~n" (reverse x)) - (printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a~n" - start-pos current-pos invalid-tokens-start) - (printf "parens: ~e~n" (car (send parens test))))) - - ;; ------------------------- Callbacks to Override ---------------------- - - (define/override (lock x) - ;;(printf "(lock ~a)~n" x) - (super lock x) - (when (and restart-callback (not x)) - (set! restart-callback #f) - (queue-callback (λ () (colorer-callback))))) - - - (define/override (on-focus on?) - ;;(printf "(on-focus ~a)~n" on?) - (super on-focus on?) - (match-parens (not on?))) - - (define/augment (after-edit-sequence) - ;;(printf "(after-edit-sequence)~n") + (let-values (((tok-start tok-end) + (begin + (tokenize-to-pos position) + (send tokens search! (- position start-pos)) + (values (send tokens get-root-start-position) + (send tokens get-root-end-position))))) + (cond + ((or (send parens is-close-pos? tok-start) + (= (+ start-pos tok-end) position)) + #f) + (else + (+ start-pos tok-end))))))))) + + + ;; See docs + (define/public (backward-match position cutoff) + (let ((x (internal-backward-match position cutoff))) + (cond + ((eq? x 'open) #f) + (else x)))) + + (define/private (internal-backward-match position cutoff) + (when stopped? + (error 'backward-match "called on a color:text<%> whose colorer is stopped.")) + (let ((position (skip-whitespace position 'backward #t))) + (let-values (((start end error) + (send parens match-backward (- position start-pos)))) + (cond + ((and start end (not error)) + (let ((match-pos (+ start-pos start))) + (cond + ((>= match-pos cutoff) match-pos) + (else #f)))) + ((and start end error) #f) + (else + (let-values (((tok-start tok-end) + (begin + (send tokens search! + (if (> position start-pos) + (- position start-pos 1) + 0)) + (values (send tokens get-root-start-position) + (send tokens get-root-end-position))))) + (cond + ((or (send parens is-open-pos? tok-start) + (= (+ start-pos tok-start) position)) + 'open) + (else + (+ start-pos tok-start))))))))) + + ;; See docs + (define/public (backward-containing-sexp position cutoff) + (when stopped? + (error 'backward-containing-sexp "called on a color:text<%> whose colorer is stopped.")) + (let loop ((cur-pos position)) + (let ((p (internal-backward-match cur-pos cutoff))) + (cond + ((eq? 'open p) cur-pos) + ((not p) #f) + (else (loop p)))))) + + ;; Determines whether a position is a 'comment, 'string, etc. + (define/public (classify-position position) + (when stopped? + (error 'classify-position "called on a color:text<%> whose colorer is stopped.")) + (tokenize-to-pos position) + (send tokens search! (- position start-pos)) + (send tokens get-root-data)) + + (define/private (tokenize-to-pos position) + (when (and (not up-to-date?) (<= current-pos position)) + (colorer-driver) + (tokenize-to-pos position))) + + ;; See docs + (define/public (skip-whitespace position direction comments?) + (when stopped? + (error 'skip-whitespace "called on a color:text<%> whose colorer is stopped.")) + (cond + ((and (eq? direction 'forward) + (>= position (if (eq? 'end end-pos) (last-position) end-pos))) + position) + ((and (eq? direction 'backward) (<= position start-pos)) + position) + (else + (tokenize-to-pos position) + (send tokens search! (- (if (eq? direction 'backward) (sub1 position) position) + start-pos)) + (cond + ((or (eq? 'white-space (send tokens get-root-data)) + (and comments? (eq? 'comment (send tokens get-root-data)))) + (skip-whitespace (+ start-pos + (if (eq? direction 'forward) + (send tokens get-root-end-position) + (send tokens get-root-start-position))) + direction + comments?)) + (else position))))) + + (define/private (get-close-paren pos closers) + (cond + ((null? closers) #f) + (else + (let* ((c (car closers)) + (l (string-length c))) + (insert c pos) + (let ((m (backward-match (+ l pos) start-pos))) + (cond + ((and m + (send parens is-open-pos? (- m start-pos)) + (send parens is-close-pos? (- pos start-pos))) + (delete pos (+ l pos)) + c) + (else + (delete pos (+ l pos)) + (get-close-paren pos (cdr closers))))))))) + + (inherit insert delete flash-on on-default-char) + ;; See docs + (define/public (insert-close-paren pos char flash? fixup?) + (let ((closer + (begin + (begin-edit-sequence #f #f) + (get-close-paren pos (if fixup? (map symbol->string (map cadr pairs)) null))))) + (end-edit-sequence) + (let ((insert-str (if closer closer (string char)))) + (for-each (lambda (c) + (on-default-char (new key-event% (key-code c)))) + (string->list insert-str)) + (when flash? + (unless stopped? + (let ((to-pos (backward-match (+ (string-length insert-str) pos) 0))) + (when (and to-pos + (send parens is-open-pos? (- to-pos start-pos)) + (send parens is-close-pos? (- pos start-pos))) + (flash-on to-pos (+ 1 to-pos))))))))) + + (define/public (debug-printout) + (let* ((x null) + (f (λ (a b c) (set! x (cons (list a b c) x))))) + (send tokens for-each f) + (printf "tokens: ~e~n" (reverse x)) + (set! x null) + (send invalid-tokens for-each f) + (printf "invalid-tokens: ~e~n" (reverse x)) + (printf "start-pos: ~a current-pos: ~a invalid-tokens-start ~a~n" + start-pos current-pos invalid-tokens-start) + (printf "parens: ~e~n" (car (send parens test))))) + + ;; ------------------------- Callbacks to Override ---------------------- + + (define/override (lock x) + ;;(printf "(lock ~a)~n" x) + (super lock x) + (when (and restart-callback (not x)) + (set! restart-callback #f) + (queue-callback (λ () (colorer-callback))))) + + + (define/override (on-focus on?) + ;;(printf "(on-focus ~a)~n" on?) + (super on-focus on?) + (match-parens (not on?))) + + (define/augment (after-edit-sequence) + ;;(printf "(after-edit-sequence)~n") + (when (has-focus?) + (match-parens)) + (inner (void) after-edit-sequence)) + + (define/augment (after-set-position) + ;;(printf "(after-set-position)~n") + (unless (local-edit-sequence?) + (when (has-focus?) + (match-parens))) + (inner (void) after-set-position)) + + (define/augment (after-change-style a b) + ;;(printf "(after-change-style)~n") + (unless (get-styles-fixed) + (unless (local-edit-sequence?) (when (has-focus?) - (match-parens)) - (inner (void) after-edit-sequence)) - - (define/augment (after-set-position) - ;;(printf "(after-set-position)~n") - (unless (local-edit-sequence?) - (when (has-focus?) - (match-parens))) - (inner (void) after-set-position)) - - (define/augment (after-change-style a b) - ;;(printf "(after-change-style)~n") - (unless (get-styles-fixed) - (unless (local-edit-sequence?) - (when (has-focus?) - (match-parens)))) - (inner (void) after-change-style a b)) - - (define/augment (on-set-size-constraint) - ;;(printf "(on-set-size-constraint)~n") - (unless (local-edit-sequence?) - (when (has-focus?) - (match-parens))) - (inner (void) on-set-size-constraint)) - - (define/augment (after-insert edit-start-pos change-length) - ;;(printf "(after-insert ~a ~a)~n" edit-start-pos change-length) - (do-insert/delete edit-start-pos change-length) - (inner (void) after-insert edit-start-pos change-length)) - - (define/augment (after-delete edit-start-pos change-length) - ;;(printf "(after-delete ~a ~a)~n" edit-start-pos change-length) - (do-insert/delete edit-start-pos (- change-length)) - (inner (void) after-delete edit-start-pos change-length)) - - (super-new) - - ;; need pref-callback to be in a private field - ;; so that the editor hangs on to the callback - ;; when the editor goes away, so does the callback - (define (pref-callback k v) (toggle-color v)) - (preferences:add-callback 'framework:coloring-active pref-callback #t))) + (match-parens)))) + (inner (void) after-change-style a b)) - (define -text% (text-mixin text:keymap%)) - - (define -text-mode<%> (interface ())) + (define/augment (on-set-size-constraint) + ;;(printf "(on-set-size-constraint)~n") + (unless (local-edit-sequence?) + (when (has-focus?) + (match-parens))) + (inner (void) on-set-size-constraint)) - (define text-mode-mixin - (mixin (mode:surrogate-text<%>) (-text-mode<%>) - ;; The arguments here are only used to be passed to start-colorer. Refer to its - ;; documentation. - (init-field (get-token default-lexer) - (token-sym->style (λ (x) "Standard")) - (matches null)) - - (define/override (on-disable-surrogate text) - (super on-disable-surrogate text) - (send text stop-colorer)) - - (define/override (on-enable-surrogate text) - (super on-enable-surrogate text) - (send text start-colorer token-sym->style get-token matches)) - - (super-new))) + (define/augment (after-insert edit-start-pos change-length) + ;;(printf "(after-insert ~a ~a)~n" edit-start-pos change-length) + (do-insert/delete edit-start-pos change-length) + (inner (void) after-insert edit-start-pos change-length)) + + (define/augment (after-delete edit-start-pos change-length) + ;;(printf "(after-delete ~a ~a)~n" edit-start-pos change-length) + (do-insert/delete edit-start-pos (- change-length)) + (inner (void) after-delete edit-start-pos change-length)) + + (super-new) + + ;; need pref-callback to be in a private field + ;; so that the editor hangs on to the callback + ;; when the editor goes away, so does the callback + (define (pref-callback k v) (toggle-color v)) + (preferences:add-callback 'framework:coloring-active pref-callback #t))) - (define text-mode% (text-mode-mixin mode:surrogate-text%))))) + (define -text% (text-mixin text:keymap%)) + + (define -text-mode<%> (interface ())) + + (define text-mode-mixin + (mixin (mode:surrogate-text<%>) (-text-mode<%>) + ;; The arguments here are only used to be passed to start-colorer. Refer to its + ;; documentation. + (init-field (get-token default-lexer) + (token-sym->style (λ (x) "Standard")) + (matches null)) + + (define/override (on-disable-surrogate text) + (super on-disable-surrogate text) + (send text stop-colorer)) + + (define/override (on-enable-surrogate text) + (super on-enable-surrogate text) + (send text start-colorer token-sym->style get-token matches)) + + (super-new))) + + (define text-mode% (text-mode-mixin mode:surrogate-text%))) diff --git a/collects/framework/private/comment-box.ss b/collects/framework/private/comment-box.ss index 5f0d7dad7d..87442e72a1 100644 --- a/collects/framework/private/comment-box.ss +++ b/collects/framework/private/comment-box.ss @@ -1,24 +1,18 @@ -(module comment-box mzscheme +(module comment-box (lib "a-unit.ss") (require (lib "class.ss") (lib "etc.ss") (lib "mred.ss" "mred") - (lib "unitsig.ss") "sig.ss" "../decorated-editor-snip.ss" (lib "include-bitmap.ss" "mrlib") (lib "string-constant.ss" "string-constants")) - (provide comment-box@) - - (define comment-box@ - (unit/sig framework:comment-box^ - (import [text : framework:text^] - [scheme : framework:scheme^] - [keymap : framework:keymap^]) - - (rename [-snip% snip%] - [-text% text%]) + (import [prefix text: framework:text^] + [prefix scheme: framework:scheme^] + [prefix keymap: framework:keymap^]) + (export (rename framework:comment-box^ + (-snip% snip%))) (define snipclass% (class decorated-editor-snipclass% @@ -127,4 +121,4 @@ (make-special-comment "comment")) (super-instantiate ()) (inherit set-snipclass) - (set-snipclass snipclass)))))) \ No newline at end of file + (set-snipclass snipclass)))) \ No newline at end of file diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss index 281d1966d0..19315ff591 100644 --- a/collects/framework/private/editor.ss +++ b/collects/framework/private/editor.ss @@ -1,7 +1,6 @@ -(module editor mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module editor (lib "a-unit.ss") + (require (lib "class.ss") (lib "string-constant.ss" "string-constants") "sig.ss" "../gui-utils.ss" @@ -9,24 +8,21 @@ (lib "mred-sig.ss" "mred") (lib "file.ss")) - (provide editor@) - - (define editor@ - (unit/sig framework:editor^ - (import mred^ - [autosave : framework:autosave^] - [finder : framework:finder^] - [path-utils : framework:path-utils^] - [keymap : framework:keymap^] - [icon : framework:icon^] - [preferences : framework:preferences^] - [text : framework:text^] - [pasteboard : framework:pasteboard^] - [frame : framework:frame^] - [handler : framework:handler^]) - - (rename [-keymap<%> keymap<%>]) - + (import mred^ + [prefix autosave: framework:autosave^] + [prefix finder: framework:finder^] + [prefix path-utils: framework:path-utils^] + [prefix keymap: framework:keymap^] + [prefix icon: framework:icon^] + [prefix preferences: framework:preferences^] + [prefix text: framework:text^] + [prefix pasteboard: framework:pasteboard^] + [prefix frame: framework:frame^] + [prefix handler: framework:handler^]) + (export (rename framework:editor^ + [-keymap<%> keymap<%>])) + (init-depend mred^ framework:autosave^) + ;; renaming, for editor-mixin where get-file is shadowed by a method. (define mred:get-file get-file) @@ -600,4 +596,4 @@ (set! callback-running? #f)) #f)))) 'framework:update-lock-icon)) - (super-instantiate ())))))) + (super-instantiate ())))) diff --git a/collects/framework/private/exit.ss b/collects/framework/private/exit.ss index cc74447122..99b7db4ef7 100644 --- a/collects/framework/private/exit.ss +++ b/collects/framework/private/exit.ss @@ -1,6 +1,5 @@ -(module exit mzscheme - (require (lib "unitsig.ss") - (lib "string-constant.ss" "string-constants") +(module exit (lib "a-unit.ss") + (require (lib "string-constant.ss" "string-constants") (lib "class.ss") "sig.ss" "../gui-utils.ss" @@ -8,13 +7,10 @@ (lib "file.ss") (lib "etc.ss")) - (provide exit@) - - (define exit@ - (unit/sig framework:exit^ - (import mred^ - [preferences : framework:preferences^]) - (rename (-exit exit)) + (import mred^ + [prefix preferences: framework:preferences^]) + (export (rename framework:exit^ + (-exit exit))) (define can?-callbacks '()) (define on-callbacks '()) @@ -79,4 +75,4 @@ (exit) (set! is-exiting? #f)))] [else - (set! is-exiting? #f)]))))) + (set! is-exiting? #f)]))) diff --git a/collects/framework/private/exn.ss b/collects/framework/private/exn.ss index ce7215cb5f..ac6e0af7bb 100644 --- a/collects/framework/private/exn.ss +++ b/collects/framework/private/exn.ss @@ -1,18 +1,13 @@ -(module exn mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module exn (lib "a-unit.ss") + (require (lib "class.ss") "sig.ss" (lib "mred-sig.ss" "mred")) - (provide exn@) + (import) + (export (rename framework:exn^ + [struct:-exn struct:exn] + [make--exn make-exn] + [-exn? exn?])) - (define exn@ - (unit/sig framework:exn^ - (import) - - (rename [struct:-exn struct:exn] - [make--exn make-exn] - [-exn? exn?]) - - (define-struct (-exn exn) ()) - (define-struct (unknown-preference exn) ())))) + (define-struct (-exn exn) ()) + (define-struct (unknown-preference exn) ())) diff --git a/collects/framework/private/finder.ss b/collects/framework/private/finder.ss index 5db8f71660..374dc10b99 100644 --- a/collects/framework/private/finder.ss +++ b/collects/framework/private/finder.ss @@ -1,7 +1,6 @@ -(module finder mzscheme +(module finder (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") "sig.ss" "../gui-utils.ss" (lib "class.ss") @@ -11,16 +10,14 @@ (lib "file.ss") (lib "etc.ss")) - (provide finder@) - (define finder@ - (unit/sig framework:finder^ - (import mred^ - [preferences : framework:preferences^] - [keymap : framework:keymap^]) + (import mred^ + [prefix preferences: framework:preferences^] + [prefix keymap: framework:keymap^]) - (rename [-put-file put-file] - [-get-file get-file]) + (export (rename framework:finder^ + [-put-file put-file] + [-get-file get-file])) (define dialog-parent-parameter (make-parameter #f)) @@ -106,4 +103,4 @@ (apply (case (preferences:get 'framework:file-dialogs) [(std) std-get-file] [(common) common-get-file]) - args)))))) + args)))) diff --git a/collects/framework/private/frame.ss b/collects/framework/private/frame.ss index 856f2c1391..0c7d8caf15 100644 --- a/collects/framework/private/frame.ss +++ b/collects/framework/private/frame.ss @@ -1,7 +1,6 @@ -(module frame mzscheme +(module frame (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") (lib "class.ss") (lib "include.ss") "sig.ss" @@ -12,32 +11,31 @@ (lib "file.ss") (lib "etc.ss")) - (provide frame@) + (import mred^ + [prefix group: framework:group^] + [prefix preferences: framework:preferences^] + [prefix icon: framework:icon^] + [prefix handler: framework:handler^] + [prefix application: framework:application^] + [prefix panel: framework:panel^] + [prefix finder: framework:finder^] + [prefix keymap: framework:keymap^] + [prefix text: framework:text^] + [prefix pasteboard: framework:pasteboard^] + [prefix editor: framework:editor^] + [prefix canvas: framework:canvas^] + [prefix menu: framework:menu^] + [prefix scheme: framework:scheme^] + [prefix exit: framework:exit^] + [prefix comment-box: framework:comment-box^]) - (define frame@ - (unit/sig framework:frame^ - (import mred^ - [group : framework:group^] - [preferences : framework:preferences^] - [icon : framework:icon^] - [handler : framework:handler^] - [application : framework:application^] - [panel : framework:panel^] - [finder : framework:finder^] - [keymap : framework:keymap^] - [text : framework:text^] - [pasteboard : framework:pasteboard^] - [editor : framework:editor^] - [canvas : framework:canvas^] - [menu : framework:menu^] - [scheme : framework:scheme^] - [exit : framework:exit^] - [comment-box : framework:comment-box^]) - - (rename [-editor<%> editor<%>] - [-pasteboard% pasteboard%] - [-text% text%]) + (export (rename framework:frame^ + [-editor<%> editor<%>] + [-pasteboard% pasteboard%] + [-text% text%])) + (init-depend mred^ framework:text^) + (define (reorder-menus frame) (define items (send (send frame get-menu-bar) get-items)) (define (find-menu name) @@ -2374,4 +2372,4 @@ (define searchable% (searchable-text-mixin (searchable-mixin -text%))) (define delegate% (delegate-mixin searchable%)) - (define -pasteboard% (pasteboard-mixin open-here%))))) + (define -pasteboard% (pasteboard-mixin open-here%))) diff --git a/collects/framework/private/group.ss b/collects/framework/private/group.ss index b80a4bb086..ecd96912a3 100644 --- a/collects/framework/private/group.ss +++ b/collects/framework/private/group.ss @@ -1,25 +1,21 @@ -(module group mzscheme +(module group (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") (lib "class.ss") "sig.ss" "../gui-utils.ss" (lib "mred-sig.ss" "mred") (lib "list.ss") (lib "file.ss")) - - (provide group@) - - (define group@ - (unit/sig framework:group^ - (import mred^ - [application : framework:application^] - [frame : framework:frame^] - [preferences : framework:preferences^] - [text : framework:text^] - [canvas : framework:canvas^] - [menu : framework:menu^]) + + (import mred^ + [prefix application: framework:application^] + [prefix frame: framework:frame^] + [prefix preferences: framework:preferences^] + [prefix text: framework:text^] + [prefix canvas: framework:canvas^] + [prefix menu: framework:menu^]) + (export framework:group^) (define-struct frame (frame id)) @@ -322,4 +318,4 @@ (internal-get-the-frame-group))) (define (get-the-frame-group) - (internal-get-the-frame-group))))) + (internal-get-the-frame-group))) diff --git a/collects/framework/private/handler.ss b/collects/framework/private/handler.ss index 4722bb4585..fd653d25c1 100644 --- a/collects/framework/private/handler.ss +++ b/collects/framework/private/handler.ss @@ -1,7 +1,6 @@ -(module handler mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module handler (lib "a-unit.ss") + (require (lib "class.ss") (lib "list.ss") (lib "hierlist.ss" "hierlist") "sig.ss" @@ -10,17 +9,16 @@ (lib "file.ss") (lib "string-constant.ss" "string-constants")) - (provide handler@) - - (define handler@ - (unit/sig framework:handler^ - (import mred^ - [finder : framework:finder^] - [group : framework:group^] - [text : framework:text^] - [preferences : framework:preferences^] - [frame : framework:frame^]) - + + (import mred^ + [prefix finder: framework:finder^] + [prefix group: framework:group^] + [prefix text: framework:text^] + [prefix preferences: framework:preferences^] + [prefix frame: framework:frame^]) + (export framework:handler^) + (init-depend framework:frame^) + (define-struct handler (name extension handler)) (define format-handlers '()) @@ -392,4 +390,4 @@ (send *open-directory* set-from-file! file)) (and file - (edit-file file)))))))) + (edit-file file)))))) diff --git a/collects/framework/private/icon.ss b/collects/framework/private/icon.ss index e61d24b442..9aef927723 100644 --- a/collects/framework/private/icon.ss +++ b/collects/framework/private/icon.ss @@ -1,17 +1,13 @@ -(module icon mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module icon (lib "a-unit.ss") + (require (lib "class.ss") (lib "include-bitmap.ss" "mrlib") "bday.ss" "sig.ss" (lib "mred-sig.ss" "mred")) + + (import mred^) + (export framework:icon^) - (provide icon@) - - (define icon@ - (unit/sig framework:icon^ - (import mred^) - (define eof-bitmap (delay (include-bitmap (lib "eof.gif" "icons")))) (define (get-eof-bitmap) (force eof-bitmap)) @@ -73,4 +69,4 @@ (force (if (mrf-bday?) mrf-off-bitmap - gc-off-bitmap)))))) + gc-off-bitmap)))) diff --git a/collects/framework/private/keymap.ss b/collects/framework/private/keymap.ss index 1ecb5e68bc..ddb41405f6 100644 --- a/collects/framework/private/keymap.ss +++ b/collects/framework/private/keymap.ss @@ -1,26 +1,23 @@ -(module keymap mzscheme +(module keymap (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") (lib "class.ss") (lib "list.ss") (lib "mred-sig.ss" "mred") (lib "match.ss") "sig.ss") - (provide keymap@) + + (import mred^ + [prefix preferences: framework:preferences^] + [prefix finder: framework:finder^] + [prefix handler: framework:handler^] + [prefix frame: framework:frame^] + [prefix editor: framework:editor^]) + (export (rename framework:keymap^ + [-get-file get-file])) + (init-depend mred^) - (define keymap@ - (unit/sig framework:keymap^ - (import mred^ - [preferences : framework:preferences^] - [finder : framework:finder^] - [handler : framework:handler^] - [frame : framework:frame^] - [editor : framework:editor^]) - - (rename [-get-file get-file]) - (define user-keybindings-files (make-hash-table 'equal)) (define (add-user-keybindings-file spec) @@ -1342,4 +1339,4 @@ (λ (keymap) (send keymap chain-to-keymap global #t) (ctki keymap))]) - (thunk))))))) + (thunk))))) diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index d8b7589c6e..94e5dc236a 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -1,24 +1,22 @@ -(module main mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module main (lib "a-unit.ss") + (require (lib "class.ss") "sig.ss" "../gui-utils.ss" (lib "string-constant.ss" "string-constants") (lib "mred-sig.ss" "mred")) - (provide main@) + (import mred^ + [prefix preferences: framework:preferences^] + [prefix exit: framework:exit^] + [prefix group: framework:group^] + [prefix handler: framework:handler^] + [prefix editor: framework:editor^] + [prefix color-prefs: framework:color-prefs^] + [prefix scheme: framework:scheme^]) + (export framework:main^) + (init-depend framework:preferences^ framework:exit^ framework:editor^ + framework:color-prefs^ framework:scheme^) - (define main@ - (unit/sig framework:main^ - (import mred^ - [preferences : framework:preferences^] - [exit : framework:exit^] - [group : framework:group^] - [handler : framework:handler^] - [editor : framework:editor^] - [color-prefs : framework:color-prefs^] - [scheme : framework:scheme^]) - (application-preferences-handler (λ () (preferences:show-dialog))) (preferences:set-default 'framework:square-bracket:cond/offset @@ -319,4 +317,4 @@ ;; the application. ;(preferences:set 'framework:file-dialogs 'std) - (void)))) + (void)) diff --git a/collects/framework/private/menu.ss b/collects/framework/private/menu.ss index c890e4fbd0..a406225ba4 100644 --- a/collects/framework/private/menu.ss +++ b/collects/framework/private/menu.ss @@ -1,15 +1,11 @@ -(module menu mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module menu (lib "a-unit.ss") + (require (lib "class.ss") "sig.ss" (lib "mred-sig.ss" "mred")) - (provide menu@) - - (define menu@ - (unit/sig framework:menu^ - (import mred^ - [preferences : framework:preferences^]) + (import mred^ + [prefix preferences: framework:preferences^]) + (export framework:menu^) (define can-restore<%> (interface (selectable-menu-item<%>) @@ -49,4 +45,4 @@ (define can-restore-menu-item% (can-restore-mixin menu-item%)) (define can-restore-checkable-menu-item% (can-restore-mixin checkable-menu-item%)) - (define can-restore-underscore-menu% (can-restore-underscore-mixin menu%))))) + (define can-restore-underscore-menu% (can-restore-underscore-mixin menu%))) diff --git a/collects/framework/private/mode.ss b/collects/framework/private/mode.ss index 90adb9068a..ec5456dcbb 100644 --- a/collects/framework/private/mode.ss +++ b/collects/framework/private/mode.ss @@ -1,14 +1,10 @@ -(module mode mzscheme +(module mode (lib "a-unit.ss") (require (lib "surrogate.ss") - (lib "unitsig.ss") (lib "class.ss") "sig.ss") - (provide mode@) - - (define mode@ - (unit/sig framework:mode^ - (import) + (import) + (export framework:mode^) (define-values (host-text-mixin host-text<%> surrogate-text% surrogate-text<%>) (surrogate @@ -51,4 +47,4 @@ (augment #t can-set-size-constraint? ()) (override can-do-edit-operation? (op) (op recursive?)) (augment #t can-load-file? (filename format)) - (augment #t can-save-file? (filename format))))))) + (augment #t can-save-file? (filename format))))) diff --git a/collects/framework/private/number-snip.ss b/collects/framework/private/number-snip.ss index 6b527bc478..c5047be6bb 100644 --- a/collects/framework/private/number-snip.ss +++ b/collects/framework/private/number-snip.ss @@ -1,18 +1,15 @@ -(module number-snip mzscheme - (require (lib "unitsig.ss") - "sig.ss" +(module number-snip (lib "a-unit.ss") + (require "sig.ss" (lib "mred-sig.ss" "mred") (lib "class.ss") (lib "string-constant.ss" "string-constants")) - (provide number-snip@) - - (define number-snip@ - (unit/sig framework:number-snip^ - (import mred^ - [preferences : framework:preferences^]) - (rename [-snip-class% snip-class%]) + (import mred^ + [prefix preferences: framework:preferences^]) + (export (rename framework:number-snip^ + [-snip-class% snip-class%])) + (init-depend mred^) ;; make-repeating-decimal-snip : number boolean -> snip (define (make-repeating-decimal-snip number e-prefix?) @@ -518,4 +515,4 @@ (define (hash-table-bound? ht key) (let/ec k (hash-table-get ht key (λ () (k #f))) - #t))))) \ No newline at end of file + #t))) \ No newline at end of file diff --git a/collects/framework/private/panel.ss b/collects/framework/private/panel.ss index 470196ffb7..189f1231a8 100644 --- a/collects/framework/private/panel.ss +++ b/collects/framework/private/panel.ss @@ -1,18 +1,15 @@ -(module panel mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module panel (lib "a-unit.ss") + (require (lib "class.ss") "sig.ss" (lib "mred-sig.ss" "mred") (lib "list.ss") (lib "etc.ss")) - (provide panel@) - - (define panel@ - (unit/sig framework:panel^ - (import [icon : framework:icon^] - mred^) + (import [prefix icon: framework:icon^] + mred^) + (export framework:panel^) + (init-depend mred^) (define single<%> (interface (area-container<%>) active-child)) (define single-mixin @@ -422,5 +419,5 @@ (define vertical-dragable% (vertical-dragable-mixin (dragable-mixin vertical-panel%))) - (define horizontal-dragable% (horizontal-dragable-mixin (dragable-mixin horizontal-panel%)))))) + (define horizontal-dragable% (horizontal-dragable-mixin (dragable-mixin horizontal-panel%)))) diff --git a/collects/framework/private/pasteboard.ss b/collects/framework/private/pasteboard.ss index e9fdb5d1b1..73990001cd 100644 --- a/collects/framework/private/pasteboard.ss +++ b/collects/framework/private/pasteboard.ss @@ -1,20 +1,17 @@ -(module pasteboard mzscheme - (require (lib "unitsig.ss") - "sig.ss" +(module pasteboard (lib "a-unit.ss") + (require "sig.ss" (lib "mred-sig.ss" "mred")) - (provide pasteboard@) - - (define pasteboard@ - (unit/sig framework:pasteboard^ - (import mred^ - [editor : framework:editor^]) - - (rename [-keymap% keymap%]) - + (import mred^ + [prefix editor: framework:editor^]) + (export (rename framework:pasteboard^ + [-keymap% keymap%])) + (init-depend mred^ framework:editor^) + + (define basic% (editor:basic-mixin pasteboard%)) (define standard-style-list% (editor:standard-style-list-mixin basic%)) (define -keymap% (editor:keymap-mixin standard-style-list%)) (define file% (editor:file-mixin -keymap%)) (define backup-autosave% (editor:backup-autosave-mixin file%)) - (define info% (editor:info-mixin backup-autosave%))))) + (define info% (editor:info-mixin backup-autosave%))) diff --git a/collects/framework/private/path-utils.ss b/collects/framework/private/path-utils.ss index f81b52a79e..a45302a379 100644 --- a/collects/framework/private/path-utils.ss +++ b/collects/framework/private/path-utils.ss @@ -1,13 +1,9 @@ -(module path-utils mzscheme - (require (lib "unitsig.ss") - "sig.ss" +(module path-utils (lib "a-unit.ss") + (require "sig.ss" (lib "mred-sig.ss" "mred")) - (provide path-utils@) - - (define path-utils@ - (unit/sig framework:path-utils^ - (import) + (import) + (export framework:path-utils^) (define (generate-autosave-name name) (let-values ([(base name dir?) @@ -58,5 +54,5 @@ [(eq? (system-type) 'windows) (build-path base (bytes->path-element (bytes-append name-bytes #".bak")))] [else - (build-path base (bytes->path-element (bytes-append name-bytes #"~")))])))))))) + (build-path base (bytes->path-element (bytes-append name-bytes #"~")))])))))) diff --git a/collects/framework/private/preferences.ss b/collects/framework/private/preferences.ss index 80d06b4627..ad6123c2ba 100644 --- a/collects/framework/private/preferences.ss +++ b/collects/framework/private/preferences.ss @@ -40,9 +40,8 @@ for the last one, need a global "no more initialization can happen" flag. |# -(module preferences mzscheme +(module preferences (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") (lib "class.ss") (lib "file.ss") (lib "etc.ss") @@ -52,16 +51,13 @@ for the last one, need a global "no more initialization can happen" flag. (lib "pretty.ss") (lib "list.ss")) - (provide preferences@) - (define preferences@ - (unit/sig framework:preferences^ - (import mred^ - [exn : framework:exn^] - [exit : framework:exit^] - [panel : framework:panel^] - [frame : framework:frame^]) - - (rename [-read read]) + (import mred^ + [prefix exn: framework:exn^] + [prefix exit: framework:exit^] + [prefix panel: framework:panel^] + [prefix frame: framework:frame^]) + (export framework:preferences^) + (define main-preferences-symbol 'plt:framework-prefs) @@ -922,4 +918,4 @@ for the last one, need a global "no more initialization can happen" flag. (define (add-font-panel) (local-add-font-panel)) - (-read)))) + (-read)) diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss index be4e2a192a..7ae723ee2e 100644 --- a/collects/framework/private/scheme.ss +++ b/collects/framework/private/scheme.ss @@ -1,10 +1,9 @@ ;; originally by Dan Grossman ;; 6/30/95 -(module scheme mzscheme +(module scheme (lib "a-unit.ss") (require "collapsed-snipclass-helpers.ss" (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") (lib "class.ss") "sig.ss" (lib "mred-sig.ss" "mred") @@ -16,31 +15,31 @@ (lib "scheme-lexer.ss" "syntax-color") "../gui-utils.ss") - (provide scheme@) - - (define (scheme-paren:get-paren-pairs) - '(("(" . ")") - ("[" . "]") - ("{" . "}"))) - - (define scheme@ - (unit/sig framework:scheme^ - (import mred^ - [preferences : framework:preferences^] - [icon : framework:icon^] - [keymap : framework:keymap^] - [text : framework:text^] - [editor : framework:editor^] - [frame : framework:frame^] - [comment-box : framework:comment-box^] - [mode : framework:mode^] - [color : framework:color^] - [color-prefs : framework:color-prefs^]) + (import mred^ + [prefix preferences: framework:preferences^] + [prefix icon: framework:icon^] + [prefix keymap: framework:keymap^] + [prefix text: framework:text^] + [prefix editor: framework:editor^] + [prefix frame: framework:frame^] + [prefix comment-box: framework:comment-box^] + [prefix mode: framework:mode^] + [prefix color: framework:color^] + [prefix color-prefs: framework:color-prefs^]) - (rename [-text-mode<%> text-mode<%>] - [-text<%> text<%>] - [-text% text%]) + (export (rename framework:scheme^ + [-text-mode<%> text-mode<%>] + [-text<%> text<%>] + [-text% text%])) + + (init-depend mred^ framework:keymap^ framework:color^ framework:mode^ + framework:text^ framework:editor^) + + (define (scheme-paren:get-paren-pairs) + '(("(" . ")") + ("[" . "]") + ("{" . "}"))) (define text-balanced? (opt-lambda (text [start 0] [in-end #f]) @@ -1651,4 +1650,5 @@ (preferences:add-callback 'framework:tabify (λ (p v) (update-gui v))) main-panel) - ))) + ) + diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss index 10298bc31c..ac467b203f 100644 --- a/collects/framework/private/sig.ss +++ b/collects/framework/private/sig.ss @@ -1,107 +1,21 @@ - (module sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) - (provide framework:menu^ - framework:menu-class^ - framework:menu-fun^ - framework:version^ - framework:version-class^ - framework:version-fun^ - framework:panel^ - framework:panel-class^ - framework:panel-fun^ - framework:exn^ - framework:exn-class^ - framework:exn-fun^ - framework:application^ - framework:application-class^ - framework:application-fun^ - framework:preferences^ - framework:preferences-class^ - framework:preferences-fun^ - framework:autosave^ - framework:autosave-class^ - framework:autosave-fun^ - framework:exit^ - framework:exit-class^ - framework:exit-fun^ - framework:path-utils^ - framework:path-utils-class^ - framework:path-utils-fun^ - framework:finder^ - framework:finder-class^ - framework:finder-fun^ - framework:editor^ - framework:editor-class^ - framework:editor-fun^ - framework:pasteboard^ - framework:pasteboard-class^ - framework:pasteboard-fun^ - framework:text^ - framework:text-class^ - framework:text-fun^ - framework:canvas^ - framework:canvas-class^ - framework:canvas-fun^ - framework:frame^ - framework:frame-class^ - framework:frame-fun^ - framework:group^ - framework:group-class^ - framework:group-fun^ - framework:handler^ - framework:handler-class^ - framework:handler-fun^ - framework:icon^ - framework:icon-class^ - framework:icon-fun^ - framework:keymap^ - framework:keymap-class^ - framework:keymap-fun^ - framework:color^ - framework:color-class^ - framework:color-fun^ - framework:color-prefs^ - framework:color-prefs-class^ - framework:color-prefs-fun^ - framework:scheme^ - framework:scheme-class^ - framework:scheme-fun^ - framework:main^ - framework:main-class^ - framework:main-fun^ - framework:mode^ - framework:mode-class^ - framework:mode-fun^ - framework:color-model^ - framework:color-model-class^ - framework:color-model-fun^ - framework:comment-box-fun^ - framework:comment-box-class^ - framework:comment-box^ - framework:number-snip^ - framework:number-snip-fun^ - framework:number-snip-class^) - - (define-signature framework:number-snip-fun^ + (provide (prefix-all-defined-except framework: framework^) + framework^) + + (define-signature number-snip-class^ + (snip-class%)) + (define-signature number-snip^ extends number-snip-class^ (make-repeating-decimal-snip make-fraction-snip)) - (define-signature framework:number-snip-class^ - (snip-class%)) - (define-signature framework:number-snip^ - ((open framework:number-snip-fun^) - (open framework:number-snip-class^))) - - (define-signature framework:comment-box-fun^ - ()) - (define-signature framework:comment-box-class^ + + (define-signature comment-box-class^ (snipclass snip%)) - (define-signature framework:comment-box^ - ((open framework:comment-box-fun^) - (open framework:comment-box-class^))) - - (define-signature framework:menu-class^ + (define-signature comment-box^ extends comment-box-class^ + ()) + + (define-signature menu-class^ (can-restore<%> can-restore-mixin can-restore-underscore<%> @@ -109,22 +23,16 @@ can-restore-menu-item% can-restore-checkable-menu-item% can-restore-underscore-menu%)) - (define-signature framework:menu-fun^ + (define-signature menu^ extends menu-class^ ()) - (define-signature framework:menu^ - ((open framework:menu-class^) - (open framework:menu-fun^))) - (define-signature framework:version-class^ + (define-signature version-class^ ()) - (define-signature framework:version-fun^ + (define-signature version^ extends version-class^ (add-spec version)) - (define-signature framework:version^ - ((open framework:version-class^) - (open framework:version-fun^))) - (define-signature framework:panel-class^ + (define-signature panel-class^ (single-mixin single<%> @@ -149,32 +57,23 @@ horizontal-dragable<%> horizontal-dragable-mixin horizontal-dragable%)) - (define-signature framework:panel-fun^ + (define-signature panel^ extends panel-class^ ()) - (define-signature framework:panel^ - ((open framework:panel-class^) - (open framework:panel-fun^))) - (define-signature framework:exn-class^ + (define-signature exn-class^ ()) - (define-signature framework:exn-fun^ + (define-signature exn^ extends exn-class^ ((struct exn ()) (struct unknown-preference ()))) - (define-signature framework:exn^ - ((open framework:exn-class^) - (open framework:exn-fun^))) - (define-signature framework:application-class^ + (define-signature application-class^ ()) - (define-signature framework:application-fun^ + (define-signature application^ extends application-class^ (current-app-name)) - (define-signature framework:application^ - ((open framework:application-class^) - (open framework:application-fun^))) - (define-signature framework:preferences-class^ + (define-signature preferences-class^ ()) - (define-signature framework:preferences-fun^ + (define-signature preferences^ extends preferences-class^ (get add-callback set @@ -201,22 +100,16 @@ show-dialog hide-dialog)) - (define-signature framework:preferences^ - ((open framework:preferences-class^) - (open framework:preferences-fun^))) - (define-signature framework:autosave-class^ + (define-signature autosave-class^ (autosavable<%>)) - (define-signature framework:autosave-fun^ + (define-signature autosave^ extends autosave-class^ (register restore-autosave-files/gui)) - (define-signature framework:autosave^ - ((open framework:autosave-class^) - (open framework:autosave-fun^))) - (define-signature framework:exit-class^ + (define-signature exit-class^ ()) - (define-signature framework:exit-fun^ + (define-signature exit^ extends exit-class^ (set-exiting exiting? user-oks-exit @@ -225,22 +118,16 @@ can-exit? on-exit exit)) - (define-signature framework:exit^ - ((open framework:exit-class^) - (open framework:exit-fun^))) - (define-signature framework:path-utils-class^ + (define-signature path-utils-class^ ()) - (define-signature framework:path-utils-fun^ + (define-signature path-utils^ extends path-utils-class^ (generate-autosave-name generate-backup-name)) - (define-signature framework:path-utils^ - ((open framework:path-utils-class^) - (open framework:path-utils-fun^))) - (define-signature framework:finder-class^ + (define-signature finder-class^ ()) - (define-signature framework:finder-fun^ + (define-signature finder^ extends finder-class^ (dialog-parent-parameter default-extension default-filters @@ -251,11 +138,8 @@ common-get-file-list get-file put-file)) - (define-signature framework:finder^ - ((open framework:finder-class^) - (open framework:finder-fun^))) - (define-signature framework:editor-class^ + (define-signature editor-class^ (basic<%> standard-style-list<%> keymap<%> @@ -270,30 +154,24 @@ info-mixin file-mixin backup-autosave-mixin)) - (define-signature framework:editor-fun^ + (define-signature editor^ extends editor-class^ (get-standard-style-list set-standard-style-list-pref-callbacks set-standard-style-list-delta set-default-font-color get-default-color-style-name)) - (define-signature framework:editor^ - ((open framework:editor-class^) - (open framework:editor-fun^))) - (define-signature framework:pasteboard-class^ + (define-signature pasteboard-class^ (basic% standard-style-list% keymap% file% backup-autosave% info%)) - (define-signature framework:pasteboard-fun^ + (define-signature pasteboard^ extends pasteboard-class^ ()) - (define-signature framework:pasteboard^ - ((open framework:pasteboard-class^) - (open framework:pasteboard-fun^))) - (define-signature framework:text-class^ + (define-signature text-class^ (basic<%> foreground-color<%> hide-caret/selection<%> @@ -339,13 +217,10 @@ clever-file-format-mixin ports-mixin input-box-mixin)) - (define-signature framework:text-fun^ + (define-signature text^ extends text-class^ ()) - (define-signature framework:text^ - ((open framework:text-class^) - (open framework:text-fun^))) - (define-signature framework:canvas-class^ + (define-signature canvas-class^ (basic<%> color<%> delegate<%> @@ -363,13 +238,10 @@ delegate-mixin info-mixin wide-snip-mixin)) - (define-signature framework:canvas-fun^ + (define-signature canvas^ extends canvas-class^ ()) - (define-signature framework:canvas^ - ((open framework:canvas-class^) - (open framework:canvas-fun^))) - (define-signature framework:frame-class^ + (define-signature frame-class^ (basic<%> size-pref<%> register-group<%> @@ -415,26 +287,20 @@ info-mixin text-info-mixin pasteboard-info-mixin)) - (define-signature framework:frame-fun^ + (define-signature frame^ extends frame-class^ (reorder-menus remove-empty-menus add-snip-menu-items setup-size-pref)) - (define-signature framework:frame^ - ((open framework:frame-class^) - (open framework:frame-fun^))) - (define-signature framework:group-class^ + (define-signature group-class^ (%)) - (define-signature framework:group-fun^ + (define-signature group^ extends group-class^ (get-the-frame-group)) - (define-signature framework:group^ - ((open framework:group-class^) - (open framework:group-fun^))) - (define-signature framework:handler-class^ + (define-signature handler-class^ ()) - (define-signature framework:handler-fun^ + (define-signature handler^ extends handler-class^ (handler? handler-name handler-extension @@ -450,13 +316,10 @@ set-recent-position set-recent-items-frame-superclass size-recently-opened-files)) - (define-signature framework:handler^ - ((open framework:handler-class^) - (open framework:handler-fun^))) - (define-signature framework:icon-class^ + (define-signature icon-class^ ()) - (define-signature framework:icon-fun^ + (define-signature icon^ extends icon-class^ (get-paren-highlight-bitmap get-autowrap-bitmap get-eof-bitmap @@ -470,15 +333,12 @@ get-gc-on-bitmap get-gc-off-bitmap)) - (define-signature framework:icon^ - ((open framework:icon-class^) - (open framework:icon-fun^))) - (define-signature framework:keymap-class^ + (define-signature keymap-class^ (aug-keymap% aug-keymap<%> aug-keymap-mixin)) - (define-signature framework:keymap-fun^ + (define-signature keymap^ extends keymap-class^ (send-map-function-meta make-meta-prefix-list @@ -504,11 +364,8 @@ add-user-keybindings-file remove-user-keybindings-file)) - (define-signature framework:keymap^ - ((open framework:keymap-class^) - (open framework:keymap-fun^))) - (define-signature framework:color-class^ + (define-signature color-class^ (text<%> text-mixin text% @@ -516,27 +373,20 @@ text-mode<%> text-mode-mixin text-mode%)) - (define-signature framework:color-fun^ + (define-signature color^ extends color-class^ ()) - (define-signature framework:color^ - ((open framework:color-class^) - (open framework:color-fun^))) - (define-signature framework:color-prefs-class^ + (define-signature color-prefs-class^ ()) - (define-signature framework:color-prefs-fun^ + (define-signature color-prefs^ extends color-prefs-class^ (register-color-pref add-to-preferences-panel build-color-selection-panel add-background-preferences-panel marshall-style - unmarshall-style)) - (define-signature framework:color-prefs^ - ((open framework:color-prefs-class^) - (open framework:color-prefs-fun^))) + unmarshall-style)) - - (define-signature framework:scheme-class^ + (define-signature scheme-class^ (text<%> text-mixin text% @@ -549,7 +399,7 @@ sexp-snip% sexp-snip<%>)) - (define-signature framework:scheme-fun^ + (define-signature scheme^ extends scheme-class^ (get-wordbreak-map init-wordbreak-map get-keymap @@ -562,29 +412,20 @@ short-sym->style-name text-balanced?)) - (define-signature framework:scheme^ - ((open framework:scheme-class^) - (open framework:scheme-fun^))) - (define-signature framework:main-class^ ()) - (define-signature framework:main-fun^ ()) - (define-signature framework:main^ - ((open framework:main-class^) - (open framework:main-fun^))) + (define-signature main-class^ ()) + (define-signature main^ extends main-class^ ()) - (define-signature framework:mode-class^ + (define-signature mode-class^ (host-text-mixin host-text<%> surrogate-text% surrogate-text<%>)) - (define-signature framework:mode-fun^ ()) - (define-signature framework:mode^ - ((open framework:mode-class^) - (open framework:mode-fun^))) + (define-signature mode^ extends mode-class^ ()) - (define-signature framework:color-model-class^ + (define-signature color-model-class^ ()) - (define-signature framework:color-model-fun^ + (define-signature color-model^ extends color-model-class^ (xyz? xyz-x xyz-y @@ -592,6 +433,33 @@ rgb-color-distance rgb->xyz xyz->rgb)) - (define-signature framework:color-model^ - ((open framework:color-model-class^) - (open framework:color-model-fun^)))) + + (define-signature framework^ + ((open (prefix application: application^)) + (open (prefix version: version^)) + (open (prefix color-model: color-model^)) + (open (prefix exn: exn^)) + (open (prefix mode: mode^)) + (open (prefix exit: exit^)) + (open (prefix menu: menu^)) + (open (prefix preferences: preferences^)) + (open (prefix number-snip: number-snip^)) + (open (prefix autosave: autosave^)) + (open (prefix path-utils: path-utils^)) + (open (prefix icon: icon^)) + (open (prefix keymap: keymap^)) + (open (prefix editor: editor^)) + (open (prefix pasteboard: pasteboard^)) + (open (prefix text: text^)) + (open (prefix color: color^)) + (open (prefix color-prefs: color-prefs^)) + (open (prefix comment-box: comment-box^)) + (open (prefix finder: finder^)) + (open (prefix group: group^)) + (open (prefix canvas: canvas^)) + (open (prefix panel: panel^)) + (open (prefix frame: frame^)) + (open (prefix handler: handler^)) + (open (prefix scheme: scheme^)) + (open (prefix main: main^))))) + diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index 66e55dd264..8e679cf60c 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -5,9 +5,8 @@ WARNING: printf is rebound in the body of the unit to always |# -(module text mzscheme +(module text (lib "a-unit.ss") (require (lib "string-constant.ss" "string-constants") - (lib "unitsig.ss") (lib "class.ss") (lib "match.ss") "sig.ss" @@ -16,21 +15,19 @@ WARNING: printf is rebound in the body of the unit to always (lib "interactive-value-port.ss" "mrlib") (lib "list.ss") (lib "etc.ss")) - (provide text@) - (define text@ - (unit/sig framework:text^ - (import mred^ - [icon : framework:icon^] - [editor : framework:editor^] - [preferences : framework:preferences^] - [keymap : framework:keymap^] - [color-model : framework:color-model^] - [frame : framework:frame^] - [scheme : framework:scheme^] - [number-snip : framework:number-snip^]) - - (rename [-keymap% keymap%]) + (import mred^ + [prefix icon: framework:icon^] + [prefix editor: framework:editor^] + [prefix preferences: framework:preferences^] + [prefix keymap: framework:keymap^] + [prefix color-model: framework:color-model^] + [prefix frame: framework:frame^] + [prefix scheme: framework:scheme^] + [prefix number-snip: framework:number-snip^]) + (export (rename framework:text^ + [-keymap% keymap%])) + (init-depend framework:editor^) (define original-output-port (current-output-port)) (define (printf . args) @@ -2005,4 +2002,4 @@ WARNING: printf is rebound in the body of the unit to always (define clever-file-format% (clever-file-format-mixin file%)) (define backup-autosave% (editor:backup-autosave-mixin clever-file-format%)) (define searching% (searching-mixin backup-autosave%)) - (define info% (info-mixin (editor:info-mixin searching%)))))) + (define info% (info-mixin (editor:info-mixin searching%)))) diff --git a/collects/framework/private/version.ss b/collects/framework/private/version.ss index 0e65c977fd..f82a881b05 100644 --- a/collects/framework/private/version.ss +++ b/collects/framework/private/version.ss @@ -1,16 +1,11 @@ -(module version mzscheme - (require (lib "unitsig.ss") - "sig.ss" - (lib "mred-sig.ss" "mred") - (lib "string.ss") - (lib "list.ss")) - - (provide version@) - - (define version@ - (unit/sig framework:version^ - (import) - (rename [-version version]) +(module version (lib "a-unit.ss") + (require "sig.ss" + (lib "mred-sig.ss" "mred") + (lib "string.ss") + (lib "list.ss")) + (import) + (export (rename framework:version^ + [-version version])) (define specs null) @@ -24,4 +19,4 @@ (define (add-spec sep num) (set! specs (cons (list (expr->string sep) (format "~a" num)) - specs)))))) + specs)))) diff --git a/collects/frtime/frtime-tool.ss b/collects/frtime/frtime-tool.ss index d7d33a3305..837775b46c 100644 --- a/collects/frtime/frtime-tool.ss +++ b/collects/frtime/frtime-tool.ss @@ -1,6 +1,6 @@ (module frtime-tool mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "mred.ss" "mred") (lib "etc.ss") @@ -11,9 +11,9 @@ (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) #;(define basic-frtime-language% (class* object% (drscheme:language:simple-module-based-language<%>) (define/public (get-language-numbers) diff --git a/collects/frtime/graphics-posn-less-unit.ss b/collects/frtime/graphics-posn-less-unit.ss index 7ce8f71f0a..8e3fd84c2f 100644 --- a/collects/frtime/graphics-posn-less-unit.ss +++ b/collects/frtime/graphics-posn-less-unit.ss @@ -4,9 +4,8 @@ ; ; modified by Gregory Cooper to support FrTime -(module graphics-posn-less-unit mzscheme - (require (lib "unitsig.ss") - (lib "mred-sig.ss" "mred") +(module graphics-posn-less-unit (lib "a-unit.ss") + (require (lib "mred-sig.ss" "mred") (lib "class.ss") (lib "class100.ss") (lib "etc.ss") @@ -16,13 +15,10 @@ ;(rename "frp-core.ss" send-event send-event) (lib "frp-core.ss" "frtime") "graphics-sig.ss") - (provide graphics-posn-less@) -(define graphics-posn-less@ - -(unit/sig graphics:posn-less^ - (import (mred : mred^) + (import (prefix mred: mred^) graphics:posn^) + (export graphics:posn-less^) (define send/proc (lambda (class method . args) @@ -1124,4 +1120,4 @@ (lambda (TST) (andmap (lambda (p) (p TST)) preds))) ) -)) + diff --git a/collects/frtime/graphics-sig.ss b/collects/frtime/graphics-sig.ss index 86d293c9b9..f334c98f57 100644 --- a/collects/frtime/graphics-sig.ss +++ b/collects/frtime/graphics-sig.ss @@ -1,5 +1,5 @@ (module graphics-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide graphics^ graphics:posn-less^ graphics:posn^) diff --git a/collects/frtime/graphics-unit.ss b/collects/frtime/graphics-unit.ss index 6cc4f13a70..ce49065046 100644 --- a/collects/frtime/graphics-unit.ss +++ b/collects/frtime/graphics-unit.ss @@ -1,16 +1,15 @@ (module graphics-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") "graphics-sig.ss" "graphics-posn-less-unit.ss") (provide graphics@) - (define graphics@ - (compound-unit/sig - (import [mred : mred^]) - (link [p : graphics:posn^ - ((unit/sig graphics:posn^ (import) (define-struct posn (x y))))] - [g : graphics:posn-less^ (graphics-posn-less@ mred p)]) - (export - (open p) - (open g))))) \ No newline at end of file + (define-unit posn@ (import) (export graphics:posn^) + (define-struct posn (x y))) + + (define-compound-unit/infer graphics@ + (import mred^) + (export graphics:posn^ graphics:posn-less^) + (link posn@ graphics-posn-less@))) + diff --git a/collects/frtime/graphics.ss b/collects/frtime/graphics.ss index 4fb4c885d5..749013e18a 100644 --- a/collects/frtime/graphics.ss +++ b/collects/frtime/graphics.ss @@ -1,9 +1,9 @@ (module graphics mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") (lib "mred.ss" "mred") "graphics-sig.ss" "graphics-unit.ss") - (provide-signature-elements graphics^) + (provide-signature-elements graphics:posn^ graphics:posn-less^) - (define-values/invoke-unit/sig graphics^ graphics@ #f mred^)) \ No newline at end of file + (define-values/invoke-unit/infer graphics@)) diff --git a/collects/games/aces/aces.scm b/collects/games/aces/aces.scm index 497ae091f3..a3b3131424 100644 --- a/collects/games/aces/aces.scm +++ b/collects/games/aces/aces.scm @@ -9,7 +9,7 @@ possible to remap single click (instead of double click)? (require (lib "cards.ss" "games" "cards") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "mred.ss" "mred") (lib "list.ss") (lib "string-constant.ss" "string-constants") @@ -368,4 +368,4 @@ possible to remap single click (instead of double click)? (lambda (item) (send item enable (not (null? redo-stack)))))) - (send table show #t)))) \ No newline at end of file + (send table show #t)))) diff --git a/collects/games/blackjack/blackjack.ss b/collects/games/blackjack/blackjack.ss index fef1591ab5..e5bd906bba 100644 --- a/collects/games/blackjack/blackjack.ss +++ b/collects/games/blackjack/blackjack.ss @@ -33,7 +33,7 @@ (require (lib "cards.ss" "games" "cards") (lib "mred.ss" "mred") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "list.ss")) (provide game-unit) @@ -447,4 +447,4 @@ (begin (send t move-cards-to-region deck discard-region) (shuffle-loop)) - (loop))))))))))) \ No newline at end of file + (loop))))))))))) diff --git a/collects/games/checkers/checkers.ss b/collects/games/checkers/checkers.ss index b3edda0f11..f618c9b2f3 100644 --- a/collects/games/checkers/checkers.ss +++ b/collects/games/checkers/checkers.ss @@ -7,7 +7,7 @@ (prefix gl- (lib "sgl.ss" "sgl")) (lib "gl.ss" "sgl") (lib "array.ss" "srfi" "25") - (lib "unit.ss") + (lib "unit200.ss") (lib "include-bitmap.ss" "mrlib") "honu-bitmaps.ss") diff --git a/collects/games/crazy8s/crazy8s.ss b/collects/games/crazy8s/crazy8s.ss index d7c2a01735..2410c7d2e8 100644 --- a/collects/games/crazy8s/crazy8s.ss +++ b/collects/games/crazy8s/crazy8s.ss @@ -3,7 +3,7 @@ (require (lib "cards.ss" "games" "cards") (lib "mred.ss" "mred") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "etc.ss") (lib "list.ss") (lib "async-channel.ss") diff --git a/collects/games/games.ss b/collects/games/games.ss index 79545fa981..e37ea987d5 100644 --- a/collects/games/games.ss +++ b/collects/games/games.ss @@ -1,7 +1,7 @@ (module games mzscheme (require (lib "mred.ss" "mred") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "list.ss") (lib "getinfo.ss" "setup") (lib "bitmap-label.ss" "mrlib") diff --git a/collects/games/gcalc/gcalc.ss b/collects/games/gcalc/gcalc.ss index 433920a4c6..e9f3c370bd 100644 --- a/collects/games/gcalc/gcalc.ss +++ b/collects/games/gcalc/gcalc.ss @@ -5,7 +5,7 @@ (module gcalc mzscheme (require (lib "class.ss") (lib "mred.ss" "mred") (lib "etc.ss") - "../show-help.ss" (lib "unit.ss")) + "../show-help.ss" (lib "unit200.ss")) (provide game-unit) (define customs '()) diff --git a/collects/games/ginrummy/ginrummy.ss b/collects/games/ginrummy/ginrummy.ss index b9d7d71eef..481e83d03c 100644 --- a/collects/games/ginrummy/ginrummy.ss +++ b/collects/games/ginrummy/ginrummy.ss @@ -3,7 +3,7 @@ (require (lib "cards.ss" "games" "cards") (lib "mred.ss" "mred") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "list.ss")) (provide game-unit) diff --git a/collects/games/gobblet/gobblet.ss b/collects/games/gobblet/gobblet.ss index 0fcf80b81f..b7a56654bf 100644 --- a/collects/games/gobblet/gobblet.ss +++ b/collects/games/gobblet/gobblet.ss @@ -1,6 +1,6 @@ (module gobblet mzscheme (require (lib "unitsig.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "file.ss") (lib "mred.ss" "mred") "sig.ss" diff --git a/collects/games/gofish/gofish.ss b/collects/games/gofish/gofish.ss index e9be80aff0..f9f086a3df 100644 --- a/collects/games/gofish/gofish.ss +++ b/collects/games/gofish/gofish.ss @@ -3,7 +3,7 @@ (require (lib "cards.ss" "games" "cards") (lib "mred.ss" "mred") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "list.ss")) (provide game-unit) @@ -356,4 +356,4 @@ (simulate-player player-2 player-1 loop)))))) (check-done loop)))))) - \ No newline at end of file + diff --git a/collects/games/jewel/jewel.scm b/collects/games/jewel/jewel.scm index f182eeb517..91c20cf44d 100644 --- a/collects/games/jewel/jewel.scm +++ b/collects/games/jewel/jewel.scm @@ -3,7 +3,7 @@ (module jewel mzscheme - (require (lib "unit.ss") + (require (lib "unit200.ss") (lib "string.ss") (lib "class.ss") (lib "file.ss") diff --git a/collects/games/lights-out/lights-out.ss b/collects/games/lights-out/lights-out.ss index 087cf36923..612d3ceb76 100644 --- a/collects/games/lights-out/lights-out.ss +++ b/collects/games/lights-out/lights-out.ss @@ -3,7 +3,7 @@ "../show-help.ss" (lib "mred.ss" "mred") (lib "class.ss") - (lib "unit.ss")) + (lib "unit200.ss")) (provide game-unit) @@ -205,4 +205,4 @@ (random 2)))) ;(send frame stretchable-width #f) ;(send frame stretchable-height #f) - (send frame show #t)))) \ No newline at end of file + (send frame show #t)))) diff --git a/collects/games/memory/memory.ss b/collects/games/memory/memory.ss index 9d3b0935f1..8380b8bba2 100644 --- a/collects/games/memory/memory.ss +++ b/collects/games/memory/memory.ss @@ -3,7 +3,7 @@ (require (lib "cards.ss" "games" "cards") (lib "mred.ss" "mred") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "list.ss")) (provide game-unit) diff --git a/collects/games/mines/mines.ss b/collects/games/mines/mines.ss index 142c0d085c..3d853bab6b 100644 --- a/collects/games/mines/mines.ss +++ b/collects/games/mines/mines.ss @@ -12,7 +12,7 @@ (require (lib "etc.ss") ; defines build-vector (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "mred.ss" "mred")) (provide game-unit) @@ -434,4 +434,4 @@ ;; Show the frame (and handle events): (send frame show #t)))) - \ No newline at end of file + diff --git a/collects/games/paint-by-numbers/paint-by-numbers.ss b/collects/games/paint-by-numbers/paint-by-numbers.ss index 656167970e..d75aa0c4e3 100644 --- a/collects/games/paint-by-numbers/paint-by-numbers.ss +++ b/collects/games/paint-by-numbers/paint-by-numbers.ss @@ -7,7 +7,7 @@ "../show-help.ss" (lib "framework.ss" "framework") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "pretty.ss") (lib "list.ss") (lib "mred.ss" "mred")) diff --git a/collects/games/parcheesi/parcheesi.ss b/collects/games/parcheesi/parcheesi.ss index d94e56abae..4d4ff4a287 100644 --- a/collects/games/parcheesi/parcheesi.ss +++ b/collects/games/parcheesi/parcheesi.ss @@ -1,6 +1,6 @@ (module parcheesi mzscheme - (require (lib "unit.ss") + (require (lib "unit200.ss") (lib "class.ss")) (provide game-unit) diff --git a/collects/games/pousse/pousse.ss b/collects/games/pousse/pousse.ss index bc6c2a1692..31a25d4b11 100644 --- a/collects/games/pousse/pousse.ss +++ b/collects/games/pousse/pousse.ss @@ -4,7 +4,7 @@ "board-size.ss" (lib "class.ss") (lib "class100.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "mred.ss" "mred") (prefix robot: "robot.ss")) diff --git a/collects/games/same/same.ss b/collects/games/same/same.ss index 8428d0f6cf..24cd52f7fe 100644 --- a/collects/games/same/same.ss +++ b/collects/games/same/same.ss @@ -1,7 +1,7 @@ (module same mzscheme (require (lib "etc.ss") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "mred.ss" "mred") (lib "list.ss") "../show-help.ss") diff --git a/collects/games/slidey/slidey.ss b/collects/games/slidey/slidey.ss index 2599c7215f..238632a9fe 100644 --- a/collects/games/slidey/slidey.ss +++ b/collects/games/slidey/slidey.ss @@ -2,7 +2,7 @@ (module slidey mzscheme (require (lib "etc.ss") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "mred.ss" "mred")) (provide game-unit) diff --git a/collects/games/spider/spider.ss b/collects/games/spider/spider.ss index 1ffa814787..cd84ace5cd 100644 --- a/collects/games/spider/spider.ss +++ b/collects/games/spider/spider.ss @@ -6,7 +6,7 @@ (lib "mred.ss" "mred") (lib "list.ss") (lib "file.ss") - (lib "unit.ss") + (lib "unit200.ss") "../show-help.ss") (define (list-first-n l n) diff --git a/collects/graphics/graphics-posn-less-unit.ss b/collects/graphics/graphics-posn-less-unit.ss index b06020d796..9c13859c37 100644 --- a/collects/graphics/graphics-posn-less-unit.ss +++ b/collects/graphics/graphics-posn-less-unit.ss @@ -3,7 +3,7 @@ ; Originally written by Johnathan Franklin (module graphics-posn-less-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") (lib "mred.ss" "mred") (lib "class.ss") @@ -41,11 +41,11 @@ [(viewport) (finish ((string-functions 'what) viewport))])))])) -(define graphics-posn-less@ - -(unit/sig graphics:posn-less^ - (import (mred : mred^) +(define-unit graphics-posn-less@ + (import (prefix mred: mred^) graphics:posn^) + (export graphics^) + (init-depend mred^) (define send/proc (lambda (class method . args) @@ -1301,4 +1301,4 @@ (lambda (TST) (andmap (lambda (p) (p TST)) preds))) ) -)) +) diff --git a/collects/graphics/graphics-sig.ss b/collects/graphics/graphics-sig.ss index 806b9dfc7c..a3ebca5fc3 100644 --- a/collects/graphics/graphics-sig.ss +++ b/collects/graphics/graphics-sig.ss @@ -1,12 +1,12 @@ (module graphics-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) - (provide graphics^ graphics:posn-less^ graphics:posn^) + (provide graphics^ graphics:posn^) (define-signature graphics:posn^ - (make-posn posn? posn-x posn-y)) + ((struct posn (x y) -setters))) - (define-signature graphics:posn-less^ + (define-signature graphics^ (viewport? open-graphics @@ -69,7 +69,7 @@ viewport-dc viewport-buffer-dc)) - (define-signature graphics^ + #;(define-signature graphics^ ((open graphics:posn-less^) (open graphics:posn^))) ) diff --git a/collects/graphics/graphics-unit.ss b/collects/graphics/graphics-unit.ss index 6cc4f13a70..403cf4b7b1 100644 --- a/collects/graphics/graphics-unit.ss +++ b/collects/graphics/graphics-unit.ss @@ -1,16 +1,16 @@ (module graphics-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") "graphics-sig.ss" "graphics-posn-less-unit.ss") (provide graphics@) - (define graphics@ - (compound-unit/sig - (import [mred : mred^]) - (link [p : graphics:posn^ - ((unit/sig graphics:posn^ (import) (define-struct posn (x y))))] - [g : graphics:posn-less^ (graphics-posn-less@ mred p)]) - (export - (open p) - (open g))))) \ No newline at end of file + (define-unit p@ + (import) + (export graphics:posn^) + (define-struct posn (x y))) + + (define-compound-unit/infer graphics@ + (import mred^) + (export graphics:posn^ graphics^) + (link p@ graphics-posn-less@))) diff --git a/collects/graphics/graphics.ss b/collects/graphics/graphics.ss index 4fb4c885d5..a2aa763457 100644 --- a/collects/graphics/graphics.ss +++ b/collects/graphics/graphics.ss @@ -1,9 +1,14 @@ (module graphics mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") - (lib "mred.ss" "mred") + (lib "mred-unit.ss" "mred") "graphics-sig.ss" "graphics-unit.ss") - (provide-signature-elements graphics^) + (provide-signature-elements graphics^ graphics:posn^) - (define-values/invoke-unit/sig graphics^ graphics@ #f mred^)) \ No newline at end of file + (define-compound-unit/infer graphics+mred@ + (import) + (export graphics^ graphics:posn^) + (link standard-mred@ graphics@)) + + (define-values/invoke-unit/infer graphics+mred@)) \ No newline at end of file diff --git a/collects/graphics/turtle-sig.ss b/collects/graphics/turtle-sig.ss index 2eeda8ff34..aafaf6d8a3 100644 --- a/collects/graphics/turtle-sig.ss +++ b/collects/graphics/turtle-sig.ss @@ -1,18 +1,31 @@ -(module turtle-sig mzscheme - (require (lib "unitsig.ss")) - (provide turtle^) +(module turtle-sig (lib "a-signature.ss") + turtles + clear + turn turn/radians + move move-offset + draw draw-offset + erase erase-offset + + save-turtle-bitmap + + splitfn split*fn tpromptfn + turtle-window-size + + display-lines-in-drawing + + (define-syntaxes (split) + (lambda (x) + (syntax-case x () + ((_ args ...) + (syntax (splitfn (lambda () args ...))))))) - (define-signature turtle^ - (turtles - clear - turn turn/radians - move move-offset - draw draw-offset - erase erase-offset - - save-turtle-bitmap - - splitfn split*fn tpromptfn - turtle-window-size - - display-lines-in-drawing))) + (define-syntaxes (split*) + (syntax-rules () + [(_ e0 e ...) + (split*fn (list (lambda () e0) (lambda () e) ...))])) + + (define-syntaxes (tprompt) + (lambda (x) + (syntax-case x () + ((_ e1 ...) + (syntax (tpromptfn (lambda () e1 ...)))))))) diff --git a/collects/graphics/turtle-unit.ss b/collects/graphics/turtle-unit.ss index f5f69fe984..db1982c53b 100644 --- a/collects/graphics/turtle-unit.ss +++ b/collects/graphics/turtle-unit.ss @@ -1,17 +1,15 @@ -(module turtle-unit mzscheme - (require (lib "unitsig.ss") - (lib "mred-sig.ss" "mred") +(module turtle-unit (lib "a-unit.ss") + (require (lib "mred-sig.ss" "mred") (lib "class.ss") (lib "class100.ss") (lib "list.ss") (lib "etc.ss") "turtle-sig.ss") - (provide turtle@) - (define turtle@ - (unit/sig turtle^ - (import [mred : mred^]) - + (import [prefix mred: mred^]) + (export turtle^) + (init-depend mred^) + (define turtles:window #f) (define turtles:shown? #f) @@ -464,4 +462,4 @@ (send dc end-doc))] [else (mred:message-box "Turtles" - "Printing is not supported on this platform")]))))) \ No newline at end of file + "Printing is not supported on this platform")]))) \ No newline at end of file diff --git a/collects/graphics/turtles.ss b/collects/graphics/turtles.ss index d323dc02f6..ab5e67cd92 100644 --- a/collects/graphics/turtles.ss +++ b/collects/graphics/turtles.ss @@ -1,28 +1,15 @@ (module turtles mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") - (lib "mred.ss" "mred") + (lib "mred-unit.ss" "mred") "turtle-sig.ss" "turtle-unit.ss") (provide-signature-elements turtle^) - (provide split split* tprompt) - (define-values/invoke-unit/sig turtle^ turtle@ #f mred^) - - (define-syntax split - (lambda (x) - (syntax-case x () - ((_ args ...) - (syntax (splitfn (lambda () args ...))))))) - - (define-syntax split* - (syntax-rules () - [(_ e0 e ...) - (split*fn (list (lambda () e0) (lambda () e) ...))])) - - (define-syntax tprompt - (lambda (x) - (syntax-case x () - ((_ e1 ...) - (syntax (tpromptfn (lambda () e1 ...)))))))) \ No newline at end of file + (define-compound-unit/infer turtle+mred@ + (import) + (export turtle^) + (link standard-mred@ turtle@)) + + (define-values/invoke-unit/infer turtle+mred@)) \ No newline at end of file diff --git a/collects/guibuilder/tool.ss b/collects/guibuilder/tool.ss index b904419038..785ee96ef9 100644 --- a/collects/guibuilder/tool.ss +++ b/collects/guibuilder/tool.ss @@ -2,7 +2,7 @@ (module tool mzscheme (require (lib "tool.ss" "drscheme") (lib "mred.ss" "mred") - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "string-constant.ss" "string-constants") (lib "contract.ss") @@ -13,9 +13,9 @@ (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (drscheme:get/extend:extend-unit-frame diff --git a/collects/handin-client/client-gui.ss b/collects/handin-client/client-gui.ss index 742ec72832..c9ab1b4010 100644 --- a/collects/handin-client/client-gui.ss +++ b/collects/handin-client/client-gui.ss @@ -1,7 +1,7 @@ (module client-gui mzscheme (require (lib "mred.ss" "mred") (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "tool.ss" "drscheme") (lib "etc.ss") (lib "file.ss") @@ -641,8 +641,9 @@ (new handin-frame% [parent parent] [content content])))) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) + (export drscheme:tool-exports^) (define phase1 void) (define phase2 diff --git a/collects/handin-client/handin-multi.ss b/collects/handin-client/handin-multi.ss index 7b36b68a65..79e67696d5 100644 --- a/collects/handin-client/handin-multi.ss +++ b/collects/handin-client/handin-multi.ss @@ -1,8 +1,7 @@ (module handin-multi mzscheme (require (lib "class.ss") (lib "list.ss") (lib "string.ss") (lib "port.ss") - (lib "unitsig.ss") (lib "mred.ss" "mred") - (lib "framework.ss" "framework") (lib "external.ss" "browser") - "info.ss" "client-gui.ss") + (lib "mred.ss" "mred") (lib "framework.ss" "framework") + (lib "external.ss" "browser") "info.ss" "client-gui.ss") (define handin-name (#%info-lookup 'name)) (define this-collection (#%info-lookup 'collection)) diff --git a/collects/handin-server/private/coverage.ss b/collects/handin-server/private/coverage.ss index 32792bf0ef..f1eec092eb 100644 --- a/collects/handin-server/private/coverage.ss +++ b/collects/handin-server/private/coverage.ss @@ -1,8 +1,6 @@ ;; Use the stacktrace interface from errortrace to find uncovered expressions. (module coverage mzscheme - (require (lib "stacktrace.ss" "errortrace") - (lib "unitsig.ss") - (lib "list.ss")) + (require (lib "stacktrace.ss" "errortrace") (lib "unit.ss") (lib "list.ss")) ;; Test coverage run-time support (define test-coverage-enabled (make-parameter #t)) @@ -48,8 +46,7 @@ ;; no marks (define (with-mark mark expr) expr) - (define-values/invoke-unit/sig - stacktrace^ stacktrace@ #f stacktrace-imports^) + (define-values/invoke-unit/infer stacktrace@) (define errortrace-compile-handler (let ([orig (current-compile)] diff --git a/collects/handin-server/web-status-server.ss b/collects/handin-server/web-status-server.ss index a15b308421..4fc14b29b3 100644 --- a/collects/handin-server/web-status-server.ss +++ b/collects/handin-server/web-status-server.ss @@ -1,5 +1,5 @@ (module web-status-server mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "ssl-tcp-unit.ss" "net") (lib "tcp-sig.ss" "net") (lib "tcp-unit.ss" "net") @@ -65,15 +65,14 @@ (lib "logger.ss" "handin-server" "private") (lib "config.ss" "handin-server" "private"))))) - (define-values/invoke-unit/sig web-server^ - (compound-unit/sig - (import) - (link [T : net:tcp^ ((make-ssl-tcp@ - "server-cert.pem" "private-key.pem" #f #f - #f #f #f))] - [C : web-config^ (configuration)] - [S : web-server^ (web-server@ T C)]) - (export (open S))) - #f) + (define-unit-binding config@ configuration (import) (export web-config^)) + (define-unit-binding ssl-tcp@ + (make-ssl-tcp@ "server-cert.pem" "private-key.pem" #f #f #f #f #f) + (import) (export tcp^)) + (define-compound-unit/infer status-server@ + (import) + (link ssl-tcp@ config@ web-server@) + (export web-server^)) + (define-values/invoke-unit/infer status-server@) (serve))) diff --git a/collects/help/private/gui.ss b/collects/help/private/gui.ss index 2306e6ad92..21db3922aa 100644 --- a/collects/help/private/gui.ss +++ b/collects/help/private/gui.ss @@ -1,19 +1,17 @@ - -(module gui mzscheme +(module gui (lib "a-unit.ss") (require (lib "framework.ss" "framework") (lib "mred.ss" "mred") (lib "class.ss") (lib "contract.ss") (lib "etc.ss") - (lib "unitsig.ss") (lib "list.ss") (lib "file.ss") (lib "string-constant.ss" "string-constants") (lib "external.ss" "browser") - (lib "browser-sig.ss" "browser") + (prefix browser: (lib "browser-sig.ss" "browser")) (lib "url-sig.ss" "net") (lib "url-structs.ss" "net") (lib "uri-codec.ss" "net") @@ -28,12 +26,8 @@ "internal-hp.ss") - (provide gui@) - - (define gui@ - (unit/sig gui^ - (import browser^ - net:url^) + (import browser:hyper^ browser:html-export^ browser:bullet-export^ url^) + (export gui^) (define help-desk-frame<%> (interface (frame:standard-menus<%>) @@ -636,4 +630,4 @@ (send d center) (send t focus) (send d show #t) - result)))) + result)) diff --git a/collects/help/private/link.ss b/collects/help/private/link.ss index c5b5b0da00..a8a6927ee9 100644 --- a/collects/help/private/link.ss +++ b/collects/help/private/link.ss @@ -2,7 +2,7 @@ (require (lib "web-server-unit.ss" "web-server") (lib "sig.ss" "web-server") - (lib "unitsig.ss") + (lib "unit.ss") (lib "tcp-sig.ss" "net") (lib "url-sig.ss" "net") @@ -14,7 +14,7 @@ (lib "plt-installer-sig.ss" "setup") (lib "plt-installer.ss" "setup") - (lib "mred.ss" "mred") + (lib "mred-unit.ss" "mred") (lib "mred-sig.ss" "mred") "tcp-intercept.ss" @@ -24,34 +24,26 @@ "main.ss" "config.ss") - (define help-desk@ - (compound-unit/sig - (import [plt-installer : setup:plt-installer^] - [mred : mred^] - [real-tcp : net:tcp^]) - (link - [config : web-config^ (config)] - [real-url : net:url^ (url@ real-tcp)] - [web-server : web-server^ (web-server@ real-tcp config)] - - [ic-tcp : net:tcp^ (tcp-intercept@ web-server)] - [pre-ic-url : net:url^ (url@ ic-tcp)] - [ic-url : net:url^ (url-intercept@ pre-ic-url)] - [browser : browser^ (browser@ plt-installer mred ic-tcp ic-url)] - [gui : gui^ (gui@ browser ic-url)] + (define-unit-from-context inst@ setup:plt-installer^) + (define-unit-from-context real-tcp@ tcp^) + (define-unit-binding config@ config (import) (export web-config^)) + + (define-compound-unit/infer help-desk@ + (import) + (export gui^ main^ web-server^) + (link inst@ + standard-mred@ + (((real-tcp : tcp^)) real-tcp@) + config@ + (((real-url : url^)) url@ real-tcp) + (() web-server@ real-tcp) + (((ic-tcp : tcp^)) tcp-intercept@) + (((pre-ic-url : url^)) url@ ic-tcp) + (((ic-url : url^)) url-intercept@ pre-ic-url) + (() browser@ ic-tcp ic-url) + (() gui@ ic-url) + main@)) - [main : main^ (main@)]) - (export (open gui) - (open main) - (open web-server)))) - - (define-values/invoke-unit/sig ((open gui^) (open web-server^) (open main^)) - help-desk@ - #f - setup:plt-installer^ - mred^ - net:tcp^) - - (provide-signature-elements gui^) - (provide-signature-elements main^) - (provide-signature-elements web-server^)) \ No newline at end of file + (define-values/invoke-unit/infer help-desk@) + + (provide-signature-elements gui^ main^ web-server^)) diff --git a/collects/help/private/main.ss b/collects/help/private/main.ss index b578b61850..308ed3d52c 100644 --- a/collects/help/private/main.ss +++ b/collects/help/private/main.ss @@ -1,6 +1,5 @@ -(module main mzscheme - (require (lib "unitsig.ss") - (lib "sig.ss" "web-server") +(module main (lib "a-unit.ss") + (require (lib "sig.ss" "web-server") (lib "framework.ss" "framework") (lib "mred.ss" "mred") (lib "class.ss") @@ -11,12 +10,9 @@ (prefix home: "../servlets/home.ss") "sig.ss") - (provide main@) + (import) + (export main^) - (define main@ - (unit/sig main^ - (import) - ;; where should the pref stuff really go? (preferences:set-default 'drscheme:help-desk:last-url-string "" string?) (preferences:set-default 'drscheme:help-desk:frame-width 350 number?) @@ -170,4 +166,4 @@ (close-output-port out))) (render-html-to-text in text #f #t)))) - vp))))))) \ No newline at end of file + vp))))) \ No newline at end of file diff --git a/collects/help/private/sig.ss b/collects/help/private/sig.ss index e2a86c8c18..4ab77349d5 100644 --- a/collects/help/private/sig.ss +++ b/collects/help/private/sig.ss @@ -1,5 +1,5 @@ (module sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide gui^ main^) diff --git a/collects/help/private/tcp-intercept.ss b/collects/help/private/tcp-intercept.ss index 5061e5ede3..d1246f69a5 100644 --- a/collects/help/private/tcp-intercept.ss +++ b/collects/help/private/tcp-intercept.ss @@ -1,7 +1,7 @@ (module tcp-intercept mzscheme (provide tcp-intercept@ url-intercept@) - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "etc.ss") (lib "sig.ss" "web-server") (lib "tcp-sig.ss" "net") @@ -24,10 +24,8 @@ (syntax->list (syntax (names ...))))]) (syntax (begin defs ...)))])) - (define url-intercept@ - (unit/sig net:url^ - (import (raw : net:url^)) - + (define-unit url-intercept@ (import (prefix raw: url^)) (export url^) + (init-depend url^) (redefine url->string get-pure-port get-impure-port @@ -40,7 +38,7 @@ call/input-url combine-url/relative url-exception? - current-proxy-servers))) + current-proxy-servers)) (define raw:tcp-abandon-port tcp-abandon-port) (define raw:tcp-accept tcp-accept) @@ -58,9 +56,7 @@ ; primitive for bad inputs. ; : (listof nat) -> (unit/sig () -> net:tcp^) - (define tcp-intercept@ - (unit/sig net:tcp^ - (import web-server^) + (define-unit tcp-intercept@ (import web-server^) (export tcp^) ; : port -> void (define (tcp-abandon-port tcp-port) @@ -112,4 +108,4 @@ (define tcp-listen raw:tcp-listen) ; : tst -> bool - (define tcp-listener? raw:tcp-listener?)))) + (define tcp-listener? raw:tcp-listener?))) diff --git a/collects/hierlist/hierlist-sig.ss b/collects/hierlist/hierlist-sig.ss index 4542c7377c..a5201778f5 100644 --- a/collects/hierlist/hierlist-sig.ss +++ b/collects/hierlist/hierlist-sig.ss @@ -1,16 +1,11 @@ - -(module hierlist-sig mzscheme - (require (lib "unitsig.ss")) - - (provide hierlist^) - (define-signature hierlist^ - (hierarchical-list% - hierarchical-list-item<%> - hierarchical-list-item% - hierarchical-list-compound-item<%> - hierarchical-list-compound-item% - - hierarchical-item-snip% - hierarchical-list-snip%))) +(module hierlist-sig (lib "a-signature.ss") + hierarchical-list% + hierarchical-list-item<%> + hierarchical-list-item% + hierarchical-list-compound-item<%> + hierarchical-list-compound-item% + + hierarchical-item-snip% + hierarchical-list-snip%) diff --git a/collects/hierlist/hierlist-unit.ss b/collects/hierlist/hierlist-unit.ss index 02a7fcb742..ae5c8201bd 100644 --- a/collects/hierlist/hierlist-unit.ss +++ b/collects/hierlist/hierlist-unit.ss @@ -1,6 +1,6 @@ (module hierlist-unit mzscheme - (require (lib "unitsig.ss") + (require (all-except (lib "unit.ss") rename) (lib "class.ss") (lib "class100.ss") (lib "mred-sig.ss" "mred") @@ -16,10 +16,11 @@ (define turn-down-click (include-bitmap "../icons/turn-down-click.png" 'png)) (provide hierlist@) - (define hierlist@ - (unit/sig hierlist^ - (import mred^) - + (define-unit hierlist@ + (import mred^) + (export hierlist^) + (init-depend mred^) + (define-local-member-name ;; In hierarchical-list% ensure-not-selected) @@ -838,4 +839,4 @@ (allow-tab-exit #t) (send top-buffer set-cursor arrow-cursor) (min-width 150) - (min-height 200))))))) + (min-height 200)))))) diff --git a/collects/hierlist/hierlist.ss b/collects/hierlist/hierlist.ss index d817ad5f7c..0c802ed5fc 100644 --- a/collects/hierlist/hierlist.ss +++ b/collects/hierlist/hierlist.ss @@ -1,17 +1,18 @@ (module hierlist mzscheme - (require (lib "unitsig.ss") - (lib "mred-sig.ss" "mred") - (lib "mred.ss" "mred")) - + (require (lib "unit.ss") + (lib "mred-sig.ss" "mred") + (lib "mred-unit.ss" "mred")) + (require "hierlist-sig.ss" - "hierlist-unit.ss") - - - (define-values/invoke-unit/sig hierlist^ - hierlist@ - #f - mred^) + "hierlist-unit.ss") + + (define-compound-unit/infer hl + (import) + (export hierlist^) + (link standard-mred@ hierlist@)) + + (define-values/invoke-unit/infer hl) (provide-signature-elements hierlist^)) diff --git a/collects/htdch/draw/Canvas-native-methods.ss b/collects/htdch/draw/Canvas-native-methods.ss index ac5011f8b1..178071e1a3 100644 --- a/collects/htdch/draw/Canvas-native-methods.ss +++ b/collects/htdch/draw/Canvas-native-methods.ss @@ -1,11 +1,11 @@ #cs (module Canvas-native-methods mzscheme - (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss")) + (require (lib "support.scm" "htdch" "draw") (lib "unit.ss")) (define void-or-true #t) (define (imperative w@t+1 w@t) w@t+1) - (define-values/invoke-unit/sig canvas-native^ canvas-native@ #f support^) + (define-values/invoke-unit/infer canvas-native@) (provide-signature-elements canvas-native^)) diff --git a/collects/htdch/draw/World-native-methods.ss b/collects/htdch/draw/World-native-methods.ss index e177ef122a..67599c5ad4 100644 --- a/collects/htdch/draw/World-native-methods.ss +++ b/collects/htdch/draw/World-native-methods.ss @@ -1,12 +1,10 @@ #cs (module World-native-methods mzscheme - (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss")) + (require (lib "support.scm" "htdch" "draw") (lib "unit.ss")) (provide endOfTime-java.lang.String-native endOfWorld-java.lang.String-native bigBangO-double-native) (define void-or-true #t) (define (imperative world@t+1 world@t) world@t+1) - (define-values/invoke-unit/sig world-native^ world-native@ #f support^)) - - + (define-values/invoke-unit/infer world-native@)) diff --git a/collects/htdch/draw/support.scm b/collects/htdch/draw/support.scm index 1e3ec7a4bc..e741e7e890 100644 --- a/collects/htdch/draw/support.scm +++ b/collects/htdch/draw/support.scm @@ -4,7 +4,7 @@ (lib "posn.ss" "lang") (lib "class.ss") (lib "mred.ss" "mred") - (lib "unit.ss") (lib "unitsig.ss") + (lib "unit.ss") (lib "String.ss" "profj" "libs" "java" "lang") (lib "Throwable.ss" "profj" "libs""java""lang") (lib "RuntimeException.ss" "profj" "libs" "java" "lang")) @@ -49,10 +49,10 @@ (send exn RuntimeException-constructor-java.lang.String str)) (current-continuation-marks)))) - (define canvas-native@ - (unit/sig canvas-native^ - (import support^) - + (define-unit canvas-native@ + (import support^) + (export canvas-native^) + (define-syntax (wrap-start-check stx) (syntax-case stx () [(_ body ...) @@ -165,12 +165,12 @@ (define (clearLine-geometry.Posn-geometry.Posn-colors.Color-native this accs gets privates p0 p1 c) (wrap-start-check ([hash-table-get privates '%clear-solid-line] (build-posn p0) (build-posn p1) (color->symbol c)))) - )) + ) - (define world-native@ - (unit/sig world-native^ - (import support^) + (define-unit world-native@ + (import support^) + (export world-native^) (define (bigBangO-double-native this accs gets privates i) (define theCanvas ((hash-table-get accs 'theCanvas) this)) @@ -211,5 +211,5 @@ (define _ (check-string s "endOfWorld(String)" "first")) (message-box "end of world" (send s get-mzscheme-string)) (send theCanvas stop) - this))) + this)) ) diff --git a/collects/htdch/idraw/Canvas-native-methods.ss b/collects/htdch/idraw/Canvas-native-methods.ss index 1b55552d8a..f80171e62d 100644 --- a/collects/htdch/idraw/Canvas-native-methods.ss +++ b/collects/htdch/idraw/Canvas-native-methods.ss @@ -1,10 +1,10 @@ #cs (module Canvas-native-methods mzscheme - (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss")) + (require (lib "support.scm" "htdch" "draw") (lib "unit.ss")) (define void-or-true (void)) (define (imperative w@t+1 w@t) w@t+1) - (define-values/invoke-unit/sig canvas-native^ canvas-native@ #f support^) + (define-values/invoke-unit/infer canvas-native@) (provide-signature-elements canvas-native^)) diff --git a/collects/htdch/idraw/World-native-methods.ss b/collects/htdch/idraw/World-native-methods.ss index 7e95625c58..7481af79af 100644 --- a/collects/htdch/idraw/World-native-methods.ss +++ b/collects/htdch/idraw/World-native-methods.ss @@ -1,10 +1,10 @@ #cs (module World-native-methods mzscheme - (require (lib "support.scm" "htdch" "draw") (lib "unitsig.ss")) + (require (lib "support.scm" "htdch" "draw") (lib "unit.ss")) (provide endOfTime-java.lang.String-native endOfWorld-java.lang.String-native bigBangO-double-native) (define void-or-true void) (define (imperative world@t+1 world@t) world@t) - (define-values/invoke-unit/sig world-native^ world-native@ #f support^)) + (define-values/invoke-unit/infer world-native@)) diff --git a/collects/htdp/big-draw.ss b/collects/htdp/big-draw.ss index a6263390c0..5f87d3f411 100644 --- a/collects/htdp/big-draw.ss +++ b/collects/htdp/big-draw.ss @@ -5,19 +5,20 @@ (lib "etc.ss") (lib "posn.ss" "lang") (lib "prim.ss" "lang") - (lib "unitsig.ss") + (lib "unit.ss") (prefix mred: (lib "mred.ss" "mred")) (lib "class.ss") (lib "mred-sig.ss" "mred") + (lib "mred-unit.ss" "mred") (lib "graphics-sig.ss" "graphics") (lib "graphics-posn-less-unit.ss" "graphics")) - (define-values/invoke-unit/sig graphics:posn-less^ - graphics-posn-less@ #f - (mred : mred^) - graphics:posn^) + (define-unit-from-context p@ graphics:posn^) + (define-compound-unit/infer g@ (import) (export graphics^) + (link standard-mred@ p@ graphics-posn-less@)) + (define-values/invoke-unit/infer g@) - (provide-signature-elements graphics:posn-less^) + (provide-signature-elements graphics^) (define-primitive stop stop/proc) diff --git a/collects/htdp/draw-sig.ss b/collects/htdp/draw-sig.ss index f66286fd43..e99a975731 100644 --- a/collects/htdp/draw-sig.ss +++ b/collects/htdp/draw-sig.ss @@ -1,6 +1,6 @@ #cs(module draw-sig mzscheme (provide core-draw^ draw^) - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) ;; xxx-solid-rect cannot be called xxx-solid-rectangle because that ;; interferes with the existing xxx-solid-rectangle name in our unit @@ -43,5 +43,5 @@ end-of-time ; -> World )) - (define-signature draw^ core-draw^)) + (define-signature draw^ extends core-draw^ ())) \ No newline at end of file diff --git a/collects/htdp/draw.ss b/collects/htdp/draw.ss index 452e44ea80..b05ac349e7 100644 --- a/collects/htdp/draw.ss +++ b/collects/htdp/draw.ss @@ -1,7 +1,7 @@ #cs(module draw mzscheme (require (lib "big-draw.ss" "htdp") (lib "draw-sig.ss" "htdp") - (lib "unitsig.ss")) + (lib "unit.ss")) (define-syntax (draw s) (syntax-case s (produce) diff --git a/collects/htdp/graphing.ss b/collects/htdp/graphing.ss index ed62fb7a08..e3cf7482ae 100644 --- a/collects/htdp/graphing.ss +++ b/collects/htdp/graphing.ss @@ -1,6 +1,6 @@ #cs(module graphing mzscheme (require (lib "error.ss" "htdp") - (lib "unitsig.ss") + (lib "unit.ss") (lib "draw-sig.ss" "htdp") (lib "big-draw.ss" "htdp") (lib "posn.ss" "lang") diff --git a/collects/htdp/hangman.ss b/collects/htdp/hangman.ss index f22a55459c..e9862b2cd0 100644 --- a/collects/htdp/hangman.ss +++ b/collects/htdp/hangman.ss @@ -3,7 +3,7 @@ "draw-sig.ss" "big-draw.ss" (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "etc.ss") (lib "prim.ss" "lang") (lib "mred.ss" "mred")) diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss index 9ab0dbcaef..190f290df5 100644 --- a/collects/lang/htdp-langs.ss +++ b/collects/lang/htdp-langs.ss @@ -16,7 +16,7 @@ tracing todo: (prefix tr: (lib "stacktrace.ss" "trace")) (lib "pretty.ss") (prefix pc: (lib "pconvert.ss")) - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "list.ss") (lib "file.ss") @@ -48,9 +48,9 @@ tracing todo: (define init-eventspace (current-eventspace)) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define-local-member-name get-tracing-text show-tracing @@ -693,7 +693,8 @@ tracing todo: (let ([v (hash-table-get ht key)]) (set-car! v #t))))) - (define-values/invoke-unit/sig et:stacktrace^ et:stacktrace@ et et:stacktrace-imports^) + (define-values/invoke-unit et:stacktrace@ + (import et:stacktrace-imports^) (export (prefix et: et:stacktrace^))) (define calltrace-key #`(quote #,(gensym 'drscheme-calltrace-key))) @@ -746,7 +747,8 @@ tracing todo: ;; matters, again, for infinite loops) (semaphore-wait sema))))))))))) - (define-values/invoke-unit/sig tr:stacktrace^ tr:stacktrace@ tr tr:stacktrace-imports^) + (define-values/invoke-unit tr:stacktrace@ + (import tr:stacktrace-imports^) (export (prefix tr: tr:stacktrace^))) ;; add-annotation : boolean (sexp -> value) -> sexp -> value ;; adds debugging and test coverage information to `sexp' and calls `oe' @@ -846,7 +848,7 @@ tracing todo: (cond [(eq? tracing-visible? (send new get-tracing-visible?)) (void)] - [(send new tracing-visible?) + [(send new get-tracing-visible?) (show-tracing)] [else (hide-tracing)])) diff --git a/collects/lang/plt-pretty-big-text.ss b/collects/lang/plt-pretty-big-text.ss index f35f909ad1..b00f7a0d5a 100644 --- a/collects/lang/plt-pretty-big-text.ss +++ b/collects/lang/plt-pretty-big-text.ss @@ -4,7 +4,7 @@ (lib "file.ss") (lib "list.ss") (lib "class.ss") - (lib "unit.ss") + (lib "unit200.ss") (lib "unitsig.ss") (lib "include.ss") (lib "defmacro.ss") @@ -21,7 +21,7 @@ (all-from (lib "file.ss")) (all-from (lib "list.ss")) (all-from (lib "class.ss")) - (all-from (lib "unit.ss")) + (all-from (lib "unit200.ss")) (all-from (lib "unitsig.ss")) (all-from (lib "include.ss")) (all-from (lib "defmacro.ss")) diff --git a/collects/lang/private/teach.ss b/collects/lang/private/teach.ss index 33e0e02d1e..a0d6df516e 100644 --- a/collects/lang/private/teach.ss +++ b/collects/lang/private/teach.ss @@ -304,7 +304,7 @@ (define (ensure-expression stx k) (if (memq (syntax-local-context) '(expression)) (k) - (stepper-syntax-property #`(begin0 #,stx) 'stepper-skipto '(syntax-e cdr car)))) + (stepper-syntax-property #`(begin0 #,stx) 'stepper-skipto skipto/second))) ;; Use to generate nicer error messages than direct pattern ;; matching. The `where' argument is an English description @@ -1350,7 +1350,7 @@ (stepper-syntax-property #`(let () expr) 'stepper-skipto - '(syntax-e cdr cdr car))] + skipto/third)] [(_ ([name0 rhs-expr0] [name rhs-expr] ...) expr) (let ([names (syntax->list (syntax (name0 name ...)))]) (andmap identifier/non-kw? names)) @@ -1695,7 +1695,18 @@ (stepper-syntax-property (syntax/loc stx (time . exprs)) 'stepper-skipto - '(syntax-e cdr car syntax-e car syntax-e cdr car syntax-e cdr syntax-e cdr car syntax-e cdr cdr syntax-e car))] + (append + ;; let-values-bindings + skipto/second + ;; rhs of first binding + skipto/first + skipto/second + ;; 2nd term of application: + skipto/cdr + skipto/second + ;; lambda-body: + skipto/cddr + skipto/first))] [_else (bad-use-error 'time stx)])))) @@ -1873,7 +1884,8 @@ (stepper-syntax-property (syntax/loc stx (begin (set! id expr ...) set!-result)) 'stepper-skipto - '(syntax-e cdr syntax-e car)) + (append skipto/cdr + skipto/first)) (stepper-ignore-checker (syntax/loc stx (#%app values (advanced-set!-continue id expr ...))))))] [(_ id . __) (teach-syntax-error diff --git a/collects/lang/private/teachhelp.ss b/collects/lang/private/teachhelp.ss index 540bbd51c8..30d0be9df3 100644 --- a/collects/lang/private/teachhelp.ss +++ b/collects/lang/private/teachhelp.ss @@ -27,7 +27,8 @@ (list 'quote (syntax id)) tmp-id)) 'stepper-skipto - '(syntax-e cdr syntax-e cdr cdr car)) + (append skipto/cdr + skipto/third)) (syntax args)) stx)] [id @@ -39,7 +40,8 @@ tmp-id) stx) 'stepper-skipto - '(syntax-e cdr syntax-e cdr cdr car))]))))) ; this may make other stepper-skipto annotations obsolete. + (append skipto/cdr + skipto/third))]))))) (define (appropriate-use what) (case what diff --git a/collects/launcher/launcher-sig.ss b/collects/launcher/launcher-sig.ss index 37aba83599..ebcdce03a8 100644 --- a/collects/launcher/launcher-sig.ss +++ b/collects/launcher/launcher-sig.ss @@ -1,11 +1,6 @@ -(module launcher-sig mzscheme - (require (lib "unitsig.ss")) - - (provide launcher^) - - (define-signature launcher^ - (make-mred-launcher +(module launcher-sig (lib "a-signature.ss") + make-mred-launcher make-mzscheme-launcher make-mred-program-launcher @@ -35,4 +30,4 @@ build-aux-from-path current-launcher-variant available-mred-variants - available-mzscheme-variants))) + available-mzscheme-variants) diff --git a/collects/launcher/launcher-unit.ss b/collects/launcher/launcher-unit.ss index 58746427d6..9d51ba8da2 100644 --- a/collects/launcher/launcher-unit.ss +++ b/collects/launcher/launcher-unit.ss @@ -1,7 +1,6 @@ -(module launcher-unit mzscheme - (require (lib "unitsig.ss") - (lib "file.ss") +(module launcher-unit (lib "a-unit.ss") + (require (lib "file.ss") (lib "string.ss") (lib "etc.ss") @@ -14,12 +13,9 @@ (lib "winutf16.ss" "compiler" "private")) - (provide launcher@) - - (define launcher@ - (unit/sig launcher^ - (import [c : dynext:compile^] - [l : dynext:link^]) + (import (prefix c: dynext:compile^) + (prefix l: dynext:link^)) + (export launcher^) (define current-launcher-variant (make-parameter 'normal @@ -695,4 +691,4 @@ (make-mred-program-launcher file collection (mred-program-launcher-path name))) (define (install-mzscheme-program-launcher file collection name) - (make-mzscheme-program-launcher file collection (mzscheme-program-launcher-path name)))))) + (make-mzscheme-program-launcher file collection (mzscheme-program-launcher-path name)))) diff --git a/collects/launcher/launcher.ss b/collects/launcher/launcher.ss index 981b0b9087..901b0488c5 100644 --- a/collects/launcher/launcher.ss +++ b/collects/launcher/launcher.ss @@ -1,6 +1,6 @@ (module launcher mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "compile-sig.ss" "dynext") (lib "compile.ss" "dynext") @@ -10,10 +10,6 @@ (require "launcher-sig.ss" "launcher-unit.ss") - (define-values/invoke-unit/sig launcher^ - launcher@ - #f - dynext:compile^ - dynext:link^) + (define-values/invoke-unit/infer launcher@) (provide-signature-elements launcher^)) diff --git a/collects/lazy/lazy.ss b/collects/lazy/lazy.ss index 0e283dd075..f3d75f6df7 100644 --- a/collects/lazy/lazy.ss +++ b/collects/lazy/lazy.ss @@ -1,5 +1,6 @@ (module lazy mzscheme + (require-for-syntax (lib "shared.ss" "stepper" "private")) ;; ~ = lazy (or delayed) ;; ! = strict (or forced) ;; (See below for app-related names) @@ -190,18 +191,27 @@ (define-syntax (hidden-! stx) (syntax-case stx (!) - [(_ arg) (syntax-property #'(! arg) - 'stepper-skipto '(syntax-e cdr syntax-e cdr car))])) + [(_ arg) (stepper-syntax-property + #'(! arg) + 'stepper-skipto + (append skipto/cdr + skipto/second))])) (define-syntax (!*app stx) (syntax-case stx () [(_ f x ...) (let ([$$ (lambda (stx) - (syntax-property stx - 'stepper-skipto '(syntax-e cdr cdr both-l () (car))))] + (stepper-syntax-property + stx + 'stepper-skipto + (append skipto/cddr + `(both-l () (car)))))] [$ (lambda (stx) - (syntax-property stx - 'stepper-skipto '(syntax-e cdr syntax-e car)))]) + (stepper-syntax-property + stx + 'stepper-skipto + (append skipto/cdr + skipto/first)))]) (with-syntax ([(y ...) (generate-temporaries #'(x ...))]) ;; use syntax/loc for better errors etc (with-syntax ([lazy (syntax/loc stx (p y ...))] @@ -226,8 +236,8 @@ (with-syntax ([(f x ...) (rec #'(f x ...))]) #'(f x ...))])) (define (stepper-annotate stx) - (let* ([stx (syntax-property stx 'stepper-hint unwinder)] - [stx (syntax-property stx 'stepper-skip-double-break #t)]) + (let* ([stx (stepper-syntax-property stx 'stepper-hint unwinder)] + [stx (stepper-syntax-property stx 'stepper-skip-double-break #t)]) stx)) (syntax-case stx (~ ! !! !list !!list !values !!values) ;; the usual () shorthand for null diff --git a/collects/macro-debugger/tool.ss b/collects/macro-debugger/tool.ss index 729606cf36..652fdb2f53 100644 --- a/collects/macro-debugger/tool.ss +++ b/collects/macro-debugger/tool.ss @@ -2,7 +2,11 @@ (module tool mzscheme (require (lib "class.ss") (lib "list.ss") - (lib "unitsig.ss") + (lib "unit.ss") + (only (lib "unitsig.ss") + unit/sig + compound-unit/sig + define-values/invoke-unit/sig) (lib "mred.ss" "mred") (lib "framework.ss" "framework") (lib "tool.ss" "drscheme") @@ -41,8 +45,8 @@ (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ - (import drscheme:tool^) + (unit (import drscheme:tool^) + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) diff --git a/collects/make/collection-sig.ss b/collects/make/collection-sig.ss index f15a615701..c2ccb48ac3 100644 --- a/collects/make/collection-sig.ss +++ b/collects/make/collection-sig.ss @@ -1,6 +1,6 @@ (module collection-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide make:collection^) diff --git a/collects/make/collection-unit.ss b/collects/make/collection-unit.ss index 6781c4c645..35d28200ea 100644 --- a/collects/make/collection-unit.ss +++ b/collects/make/collection-unit.ss @@ -1,6 +1,6 @@ (module collection-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "list.ss") (lib "file.ss")) @@ -12,13 +12,12 @@ (provide make:collection@) - (define make:collection@ - (unit/sig - make:collection^ - (import make^ + (define-unit make:collection@ + (import make^ dynext:file^ - (compiler:option : compiler:option^) + (prefix compiler:option: compiler:option^) compiler^) + (export make:collection^) (define (make-collection collection-name @@ -105,5 +104,4 @@ ss->zo-list ss->c-list c->o-list) - argv)))))) - + argv))))) diff --git a/collects/make/collection.ss b/collects/make/collection.ss index 72b3fc257d..3c0fbb7957 100644 --- a/collects/make/collection.ss +++ b/collects/make/collection.ss @@ -1,6 +1,6 @@ (module collection mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "file-sig.ss" "dynext") (lib "file.ss" "dynext") @@ -13,12 +13,6 @@ "collection-sig.ss" "collection-unit.ss") - (define-values/invoke-unit/sig make:collection^ - make:collection@ - #f - make^ - dynext:file^ - compiler:option^ - compiler^) + (define-values/invoke-unit/infer make:collection@) (provide-signature-elements make:collection^)) diff --git a/collects/make/make-sig.ss b/collects/make/make-sig.ss index 4c52780ab1..6e956b1fd5 100644 --- a/collects/make/make-sig.ss +++ b/collects/make/make-sig.ss @@ -1,14 +1,9 @@ -(module make-sig mzscheme - (require (lib "unitsig.ss")) - - (provide make^) - - (define-signature make^ - (make/proc +(module make-sig (lib "a-signature.ss") + make/proc make-print-checking make-print-dep-no-line make-print-reasons make-notify-handler - (struct exn:fail:make (target orig-exn))))) + (struct exn:fail:make (target orig-exn))) diff --git a/collects/make/make-unit.ss b/collects/make/make-unit.ss index b2080b6786..2579f18566 100644 --- a/collects/make/make-unit.ss +++ b/collects/make/make-unit.ss @@ -1,14 +1,9 @@ -(module make-unit mzscheme - (require (lib "unitsig.ss")) - +(module make-unit (lib "a-unit.ss") (require "make-sig.ss") - (provide make@) - - (define make@ - (unit/sig make^ (import) + (export make^) (define-struct (exn:fail:make exn:fail) (target orig-exn)) @@ -169,5 +164,4 @@ (define make/proc (case-lambda [(spec) (make/proc/helper spec #())] - [(spec argv) (make/proc/helper spec argv)]))))) - + [(spec argv) (make/proc/helper spec argv)]))) diff --git a/collects/make/make.ss b/collects/make/make.ss index 4e016e9eb5..194dc60213 100644 --- a/collects/make/make.ss +++ b/collects/make/make.ss @@ -1,11 +1,11 @@ (module make mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "make-sig.ss" "make-unit.ss") - (define-values/invoke-unit/sig make^ make@) + (define-values/invoke-unit/infer make@) (provide-signature-elements make^) diff --git a/collects/mred/info.ss b/collects/mred/info.ss index f5f815a090..e0e99e4034 100644 --- a/collects/mred/info.ss +++ b/collects/mred/info.ss @@ -2,5 +2,5 @@ (module info (lib "infotab.ss" "setup") (define doc.txt "doc.txt") (define name "MrEd") - (define version '(300)) + (define version '(370)) (define post-install-collection "script-installer.ss")) diff --git a/collects/mred/mred-sig.ss b/collects/mred/mred-sig.ss index ba8a3420ad..f26ebe2cd9 100644 --- a/collects/mred/mred-sig.ss +++ b/collects/mred/mred-sig.ss @@ -1,11 +1,6 @@ -(module mred-sig mzscheme - (require (lib "unitsig.ss")) - - (provide mred^) - (define-signature - mred^ - (add-color<%> +(module mred-sig (lib "a-signature.ss") + add-color<%> add-editor-keymap-functions add-pasteboard-keymap-functions add-text-keymap-functions @@ -206,5 +201,5 @@ write-editor-version write-resource yield - ))) + ) diff --git a/collects/mred/mred-unit.ss b/collects/mred/mred-unit.ss new file mode 100644 index 0000000000..b5d8217d5f --- /dev/null +++ b/collects/mred/mred-unit.ss @@ -0,0 +1,6 @@ +(module mred-unit mzscheme + (require (lib "unit.ss") + "mred-sig.ss" + "mred.ss") + (provide standard-mred@) + (define-unit-from-context standard-mred@ mred^)) \ No newline at end of file diff --git a/collects/mrflow/gui.ss b/collects/mrflow/gui.ss index df0ad0a543..7304f136a5 100644 --- a/collects/mrflow/gui.ss +++ b/collects/mrflow/gui.ss @@ -3,7 +3,7 @@ (require (lib "tool.ss" "drscheme") - (lib "unitsig.ss") + (lib "unit.ss") (lib "list.ss") (lib "class.ss") (lib "mred.ss" "mred") @@ -20,9 +20,9 @@ (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) ; INTERFACE WITH LANGUAGES (define mrflow-language-extension-interface<%> (interface () diff --git a/collects/mzlib/a-signature.ss b/collects/mzlib/a-signature.ss new file mode 100644 index 0000000000..423abb709d --- /dev/null +++ b/collects/mzlib/a-signature.ss @@ -0,0 +1,29 @@ +(module a-signature mzscheme + (require-for-syntax "private/unit-compiletime.ss" + "private/unit-syntax.ss") + (require "unit.ss") + + (provide (rename module-begin #%module-begin) + (all-from-except mzscheme #%module-begin) + (all-from "unit.ss")) + + (define-for-syntax (make-name s) + (string->symbol + (string-append (regexp-replace "-sig$" (symbol->string s) "") + "^"))) + + (define-syntax (module-begin stx) + (parameterize ((error-syntax stx)) + (with-syntax ((name (make-name (syntax-property stx 'enclosing-module-name)))) + (syntax-case stx () + ((_ . x) + (with-syntax ((((reqs ...) . (body ...)) + (split-requires (checked-syntax->list #'x)))) + (datum->syntax-object + stx + (syntax-e #'(#%module-begin + reqs ... + (provide name) + (define-signature name (body ...)))) + stx)))))))) + diff --git a/collects/mzlib/a-unit.ss b/collects/mzlib/a-unit.ss new file mode 100644 index 0000000000..29ff65466a --- /dev/null +++ b/collects/mzlib/a-unit.ss @@ -0,0 +1,28 @@ +(module a-unit mzscheme + (require-for-syntax "private/unit-compiletime.ss" + "private/unit-syntax.ss") + (require "unit.ss") + + (provide (rename module-begin #%module-begin) + (all-from-except mzscheme #%module-begin) + (all-from "unit.ss")) + + (define-for-syntax (make-name s) + (string->symbol + (string-append (regexp-replace "-unit$" (symbol->string s) "") + "@"))) + + (define-syntax (module-begin stx) + (parameterize ((error-syntax stx)) + (with-syntax ((name (make-name (syntax-property stx 'enclosing-module-name)))) + (syntax-case stx () + ((_ . x) + (with-syntax ((((reqs ...) . (body ...)) + (split-requires (checked-syntax->list #'x)))) + (datum->syntax-object + stx + (syntax-e #'(#%module-begin + reqs ... + (provide name) + (define-unit name body ...))) + stx)))))))) diff --git a/collects/mzlib/deflate.ss b/collects/mzlib/deflate.ss index 95e0991ec6..c3c4f99ffb 100644 --- a/collects/mzlib/deflate.ss +++ b/collects/mzlib/deflate.ss @@ -12,7 +12,7 @@ (provide deflate gzip-through-ports gzip) - (require "unit.ss") + (require "unit200.ss") (define-syntax INSERT_STRING (syntax-rules () diff --git a/collects/mzlib/pconvert.ss b/collects/mzlib/pconvert.ss index fee0f9b4df..e1ce7486cd 100644 --- a/collects/mzlib/pconvert.ss +++ b/collects/mzlib/pconvert.ss @@ -4,9 +4,8 @@ (require (only "string.ss" expr->string) (only "list.ss" sort) "etc.ss" - "pconvert-prop.ss") - (require "class.ss") - (require "unit.ss") + "pconvert-prop.ss" + "class.ss") (provide show-sharing constructor-style-printing @@ -129,7 +128,6 @@ (not (procedure? expr)) (not (promise? expr)) (not (object? expr)) - (not (unit? expr)) (not (port? expr)) (not (class? expr)) (object-name expr)) @@ -382,10 +380,6 @@ ...)] [(void? expr) '(void)] [(promise? expr) '(delay ...)] - [(unit? expr) (build-named - expr - (lambda () - '(unit ...)))] [(and (number? expr) (exact? expr)) (let-values ([(whole frac whole-i frac-i) (get-whole/frac expr)]) (cond diff --git a/collects/mzlib/private/sigmatch.ss b/collects/mzlib/private/sigmatch.ss index 2ae9a42d48..784a53554b 100644 --- a/collects/mzlib/private/sigmatch.ss +++ b/collects/mzlib/private/sigmatch.ss @@ -1,7 +1,7 @@ (module sigmatch mzscheme - (require "../unit.ss") + (require "../unit200.ss") (define (hash-sig src-sig table) (and (pair? src-sig) diff --git a/collects/mzlib/private/sigutil.ss b/collects/mzlib/private/sigutil.ss index 33021b2362..2209a98f13 100644 --- a/collects/mzlib/private/sigutil.ss +++ b/collects/mzlib/private/sigutil.ss @@ -8,7 +8,7 @@ (lib "context.ss" "syntax")) (require "sigmatch.ss") - (require "../unit.ss") + (require "../unit200.ss") (require "../list.ss") (define-struct signature (name ; sym diff --git a/collects/mzlib/private/unit-compiletime.ss b/collects/mzlib/private/unit-compiletime.ss new file mode 100644 index 0000000000..1c6d9ea0b1 --- /dev/null +++ b/collects/mzlib/private/unit-compiletime.ss @@ -0,0 +1,556 @@ +(module unit-compiletime mzscheme + (require-for-syntax (lib "struct.ss" "syntax")) + (require (lib "boundmap.ss" "syntax") + (lib "list.ss") + "unit-runtime.ss" + "unit-syntax.ss") + (require-for-template mzscheme + "unit-keywords.ss" + "unit-runtime.ss") + + (provide (struct var-info (syntax? exported? id)) + (struct signature (siginfo vars val-defs stx-defs)) + (rename build-siginfo make-siginfo) + siginfo-names siginfo-ctime-ids siginfo-rtime-ids siginfo-subtype + (struct signature-form (f)) + (struct unit-info (unit-id import-sig-ids export-sig-ids)) + (struct link-record (linkid tag sigid siginfo)) + unprocess-link-record-bind unprocess-link-record-use + set!-trans-extract do-identifier + process-tagged-import process-tagged-export + lookup-signature lookup-def-unit make-id-mapper make-id-mappers sig-names sig-int-names sig-ext-names + map-sig split-requires apply-mac complete-exports complete-imports check-duplicate-subs + process-spec process-spec2) + + + (define-syntax (apply-mac stx) + (syntax-case stx () + ((_ f x) ((syntax-e #'f) #'x)))) + + ;; split-requires : (listof syntax-object) -> (values (listof syntax-object) (listof syntax-object)) + (define (split-requires l) + (let loop ((l l) + (requires null)) + (cond + ((null? l) (cons (reverse requires) l)) + (else + (syntax-case (car l) () + ((r . x) + (or (module-identifier=? #'r #'require) + (module-identifier=? #'r #'require-for-syntax) + (module-identifier=? #'r #'require-for-template)) + (loop (cdr l) (cons (car l) requires))) + (_ + (cons (reverse requires) l))))))) + + + ;; (make-var-info bool bool identifier) + (define-struct var-info (syntax? exported? id)) + + (define-syntax (define-struct/proc stx) + (syntax-case stx () + ((_ name (field ...) p) + (and (identifier? #'name) + (andmap identifier? (syntax->list #'(field ...)))) + (generate-struct-declaration + stx #'name #f (syntax->list #'(field ...)) (syntax-local-context) + (lambda (orig-stx name-stx defined-name-stxes super-info) + #`(make-struct-type '#,name-stx + #,(and super-info (list-ref super-info 0)) + #,(/ (- (length defined-name-stxes) 3) 2) + 0 #f null (current-inspector) + p)))))) + ;; An int/ext is + ;; - (cons identifier identifier) + ;; A def is + ;; - (listof (cons (listof int/ext) syntax-object)) + ;; A sig is + ;; - (list (listof int/ext) (listof def) (listof def)) + ;; A tagged-sig is + ;; - (listof (cons #f siginfo) (cons #f identifier) sig) + ;; - (listof (cons symbol siginfo) (cons symbol identifier) sig) + + ;; A siginfo is + ;; - (make-siginfo (listof symbol) (listof symbol) (listof identifier) (hash-tableof symbol bool)) + ;; where the car of each list represents the signature, and the cdr represents + ;; its super signatures. All lists are non-empty and the same length. + (define-struct siginfo (names ctime-ids rtime-ids super-table)) + + ;; build-siginfo : (listof symbol) (listof symbol) (listof identifier) -> siginfo + (define (build-siginfo names rtime-ids) + (define ctime-ids + (cons (gensym) + (if (null? (cdr names)) + null + (siginfo-ctime-ids + (signature-siginfo + (lookup-signature (cadr names))))))) + (make-siginfo names + ctime-ids + rtime-ids + (make-immutable-hash-table (map (λ (x) `(,x . #t)) ctime-ids)))) + + ;; siginfo-subtype : siginfo siginfo -> bool + (define (siginfo-subtype s1 s2) + (hash-table-get (siginfo-super-table s1) + (car (siginfo-ctime-ids s2)) + (λ () #f))) + + + ;; A signature is + ;; (make-signature siginfo + ;; (listof identifier) + ;; (listof (cons (listof identifier) syntax-object)) + ;; (listof (cons (listof identifier) syntax-object))) + (define-struct/proc signature (siginfo vars val-defs stx-defs) + (lambda (_ stx) + (parameterize ((error-syntax stx)) + (raise-stx-err "illegal use of signature name")))) + + ;; (make-signature-form (syntax-object -> any)) + (define-struct/proc signature-form (f) + (lambda (_ stx) + (parameterize ((error-syntax stx)) + (raise-stx-err "illegal use of signature form")))) + + ;; (make-unit-info identifier (listof (cons symbol identifier)) (listof (cons symbol identifier))) + (define-struct/proc unit-info (unit-id import-sig-ids export-sig-ids deps) + (lambda (struct stx) + (with-syntax ((u (unit-info-unit-id struct))) + (syntax-case stx (set!) + ((set! x y) + #`(begin + #,(syntax/loc #'y (check-unit y 'set!)) + #,(syntax/loc #'y (check-sigs y (unit-import-sigs u) (unit-export-sigs u) 'set!)) + (set! u y))) + ((_ . y) + (syntax/loc stx (u . y))) + (x + (identifier? #'x) + (quasisyntax/loc stx (values u))))))) ;; The apparently superfluous values is so the certificates aren't + ;; too permissive + + (define (lookup id err-msg) + (check-id id) + (let ((s (set!-trans-extract + (syntax-local-value + (syntax-local-introduce id) + (lambda () + (raise-stx-err err-msg id)))))) + s)) + + ;; lookup-signature : syntax-object -> signature + (define (lookup-signature id) + (let ((s (lookup id "unknown signature"))) + (unless (signature? s) + (raise-stx-err "not a signature" id)) + s)) + + (define (set!-trans-extract x) + (if (set!-transformer? x) + (set!-transformer-procedure x) + x)) + + (define (lookup-def-unit id) + (let ((u (lookup id "unknown unit definition"))) + (unless (unit-info? u) + (raise-stx-err "not a unit definition" id)) + u)) + + ;; check-module-id-subset : (listof syntax-object) (listof identifier) syntax-object -> + ;; ensures each element of i1 is an identifier module-identifier=? to an identifier in i2 + (define (check-module-id-subset i1 i2) + (let ((ht (make-module-identifier-mapping))) + (for-each (lambda (id) + (module-identifier-mapping-put! ht id #t)) + i2) + (for-each + (lambda (id) + (check-id id) + (unless (module-identifier-mapping-get ht id (lambda () #f)) + (raise-stx-err "listed identifier not present in signature specification" id))) + i1))) + + ;; do-rename : sig syntax-object syntax-object -> sig + ;; internals and externals must both be of the form (x ...) + ;; ensures that each x above is an identifier + (define (do-rename sig internals externals) + (check-module-id-subset (syntax->list externals) + (sig-int-names sig)) + (let ((ht (make-module-identifier-mapping))) + (for-each + (lambda (int ext) + (check-id int) + (when (module-identifier-mapping-get ht ext (lambda () #f)) + (raise-stx-err "duplicate renamings" ext)) + (module-identifier-mapping-put! ht ext int)) + (syntax->list internals) + (syntax->list externals)) + (map-sig + (lambda (id) + (module-identifier-mapping-get ht id (lambda () id))) + (lambda (x) x) + sig))) + + ;; do-prefix : sig syntax-object -> sig + ;; ensures that pid is an identifier + (define (do-prefix sig pid) + (check-id pid) + (let ((p (syntax-e pid))) + (map-sig + (lambda (id) + (datum->syntax-object + id + (string->symbol (format "~a~a" p (syntax-e id))))) + (lambda (x) x) + sig))) + + ;; do-only : sig (listof identifier) -> sig + ;; ensures that only-ids are identifiers and are mentioned in the signature + (define (do-only/except sig only/except-ids put get) + (check-module-id-subset only/except-ids + (sig-int-names sig)) + (let ((ht (make-module-identifier-mapping))) + (for-each (lambda (id) + (module-identifier-mapping-put! ht id (put id))) + only/except-ids) + (map-sig + (lambda (id) + (module-identifier-mapping-get ht id + (lambda () + (get id)))) + (lambda (x) x) + sig))) + + ;; do-identifier : identifier (box (cons identifier siginfo)) -> sig + (define (do-identifier spec res) + (let* ((sig (lookup-signature spec)) + (vars (signature-vars sig)) + (vals (signature-val-defs sig)) + (stxs (signature-stx-defs sig))) + (set-box! res (cons spec (signature-siginfo sig))) + (map-sig intro-o-shadow + syntax-local-introduce + (list (map cons vars vars) + (map + (λ (val) + (cons (map (λ (id) (cons id id)) + (car val)) + (cdr val))) + vals) + (map + (λ (stx) + (cons (map (λ (id) (cons id id)) + (car stx)) + (cdr stx))) + stxs))))) + + (define (sig-names sig) + (append (car sig) + (apply append (map car (cadr sig))) + (apply append (map car (caddr sig))))) + + + (define (sig-int-names sig) + (map car (sig-names sig))) + + (define (sig-ext-names sig) + (map cdr (sig-names sig))) + + ;; intro-o-shadow : identifier -> identifier + (define (intro-o-shadow id) + (syntax-local-introduce (syntax-local-get-shadower id))) + + ;; map-def : (identifier -> identifier) (syntax-object -> syntax-object) def -> def + (define (map-def f g def) + (cons (map (lambda (x) + (cons (f (car x)) (g (cdr x)))) + (car def)) + (g (cdr def)))) + + ;; map-sig : (identifier -> identifier) (sytnax-object -> syntax-object) sig -> sig + ;; applies f to the internal parts, and g to the external parts. + (define (map-sig f g sig) + (list (map (lambda (x) (cons (f (car x)) (g (cdr x)))) (car sig)) + (map (lambda (x) (map-def f g x)) (cadr sig)) + (map (lambda (x) (map-def f g x)) (caddr sig)))) + + ;; An import-spec is one of + ;; - signature-name + ;; - (only import-spec identifier ...) + ;; - (except import-spec identifier ...) + ;; - (prefix prefix-identifier import-spec) + ;; - (rename import-spec (local-identifier signature-identifier) ...) + + ;; An export-spec is one of + ;; - signature-name + ;; - (prefix prefix-identifier export-spec) + ;; - (rename export-spec (local-identifier signature-identifier) ...) + + ;; A tagged-import-spec is one of + ;; - import-spec + ;; - (tag symbol import-spec) + + ;; A tagged-export-spec is one of + ;; - export-spec + ;; - (tag symbol export-spec) + + + ;; process-tagged-import/export : syntax-object boolean -> tagged-sig + (define (process-tagged-import/export spec import?) + (define res (box #f)) + (check-tagged-spec-syntax spec import? identifier?) + (syntax-case spec (tag) + ((tag sym spec) + (let ([s (process-import/export #'spec res)]) + (list (cons (syntax-e #'sym) (cdr (unbox res))) + (cons (syntax-e #'sym) (car (unbox res))) + s))) + ((tag . _) + (raise-stx-err "expected (tag symbol )" spec)) + (_ (let ([s (process-import/export spec res)]) + (list (cons #f (cdr (unbox res))) + (cons #f (car (unbox res))) + s))))) + + + ;; process-import/export : syntax-object (box (cons identifier) siginfo) -> sig + (define (process-import/export spec res) + (syntax-case spec (only except prefix rename) + (_ + (identifier? spec) + (do-identifier spec res)) + ((only sub-spec id ...) + (do-only/except (process-import/export #'sub-spec res) + (syntax->list #'(id ...)) + (lambda (x) x) + (lambda (id) + (car (generate-temporaries #`(#,id)))))) + ((except sub-spec id ...) + (do-only/except (process-import/export #'sub-spec res) + (syntax->list #'(id ...)) + (lambda (id) + (car (generate-temporaries #`(#,id)))) + (lambda (x) x))) + ((prefix pid sub-spec) + (do-prefix (process-import/export #'sub-spec res) #'pid)) + ((rename sub-spec (internal external) ...) + (let* ((sig-res + (do-rename (process-import/export #'sub-spec res) + #'(internal ...) + #'(external ...))) + (dup (check-duplicate-identifier (sig-int-names sig-res)))) + (when dup + (raise-stx-err + (format "rename created duplicate identifier ~a" (syntax-e dup)) + spec)) + sig-res)))) + + (define (process-tagged-import spec) + (process-tagged-import/export spec #t)) + (define (process-tagged-export spec) + (process-tagged-import/export spec #f)) + + ;; process-spec : syntax-object -> sig + (define (process-spec spec) + (check-tagged-spec-syntax spec #f identifier?) + (process-import/export spec (box #f))) + + ;; process-spec2 : syntax-object -> identifier? + (define (process-spec2 spec) + (define b (box #f)) + (check-tagged-spec-syntax spec #t identifier?) + (process-import/export spec b) + (car (unbox b))) + + +; ;; extract-siginfo : (union import-spec export-spec) -> ??? +; ;; extracts the identifier that refers to the signature +; (define (extract-siginfo spec) +; (syntax-case spec (only except prefix rename) +; ((only sub-spec . x) +; (extract-siginfo #'sub-spec)) +; ((except sub-spec . x) +; (extract-siginfo #'sub-spec)) +; ((prefix pid sub-spec) +; (extract-siginfo #'sub-spec)) +; ((rename sub-spec . x) +; (extract-siginfo #'sub-spec)) +; (_ spec))) + + + + ;; check-duplicate-subs : (listof (cons symbol siginfo)) (listof syntax-object) -> + (define (check-duplicate-subs tagged-siginfos sources) + (for-each + (λ (tinfo1 s1) + (for-each + (λ (tinfo2 s2) + (unless (eq? tinfo1 tinfo2) + (when (and (eq? (car tinfo1) (car tinfo2)) + (siginfo-subtype (cdr tinfo1) (cdr tinfo2))) + (raise-stx-err (format "the signature of ~a extends this signature" + (syntax-object->datum s1)) + s2)))) + tagged-siginfos + sources)) + tagged-siginfos + sources)) + + + ;; A link-record is + ;; (make-link-record (or symbol #f) (or identifier #f) identifier siginfo) + (define-struct link-record (tag linkid sigid siginfo)) + + ;; complete-exports : (listof link-record) (listof link-record) -> (listof link-record) + ;; The export-bindings should not contain two bindings that are related as subsignatures. + (define (complete-exports unit-exports given-bindings) + (define binding-table (make-hash-table 'equal)) + (define used-binding-table (make-hash-table 'equal)) + + (check-duplicate-subs + (map (λ (ts) (cons (link-record-tag ts) (link-record-siginfo ts))) given-bindings) + (map link-record-sigid given-bindings)) + + (for-each + (λ (b) + (hash-table-put! binding-table + (cons (link-record-tag b) + (car (siginfo-ctime-ids (link-record-siginfo b)))) + (link-record-linkid b))) + given-bindings) + + (begin0 + (map + (λ (export) + (define r + (ormap + (λ (ctime-id) + (define key (cons (link-record-tag export) ctime-id)) + (define used (hash-table-get used-binding-table key (λ () #f))) + (when used + (raise-stx-err "this export is supplied multiple times by the given unit" used)) + (let ([r (hash-table-get binding-table key (λ () #f))]) + (when r + (hash-table-put! used-binding-table key r)) + r)) + (siginfo-ctime-ids (link-record-siginfo export)))) + (make-link-record + (link-record-tag export) + (cond + [r r] + [else (car (generate-temporaries (list (link-record-linkid export))))]) + (link-record-sigid export) + (link-record-siginfo export))) + unit-exports) + + (hash-table-for-each + binding-table + (λ (k v) + (unless (hash-table-get used-binding-table k (λ () #f)) + (raise-stx-err "this export is not supplied by the given unit" v)))))) + + ;; complete-imports : (hash-tableof symbol (or identifier 'duplicate)) + ;; (listof link-record) + ;; (listof (list symbol identifier siginfo)) -> + ;; (listof (cons symbol identifier)) + (define (complete-imports sig-table given-links unit-imports src) + (define linked-sigs-table (make-hash-table 'equal)) + (for-each + (λ (link) + (define tag (link-record-tag link)) + (for-each + (λ (cid) + (define there? (hash-table-get linked-sigs-table (cons tag cid) (λ () #f))) + (hash-table-put! linked-sigs-table (cons tag cid) (if there? 'duplicate #t))) + (siginfo-ctime-ids (link-record-siginfo link)))) + given-links) + + (append + given-links + (let loop ([unit-imports unit-imports]) + (cond + [(null? unit-imports) null] + [else + (let* ([import (car unit-imports)] + [ctime-ids (siginfo-ctime-ids (link-record-siginfo import))] + [tag (link-record-tag import)] + [there? + (hash-table-get linked-sigs-table + (cons tag (car ctime-ids)) + (λ () #f))]) + (cond + [(eq? 'duplicate there?) + (raise-stx-err + (if tag + (format "Specified linkages satisfy (tag ~a ~a) import multiple times" + tag (car (siginfo-names (link-record-siginfo import)))) + (format "Specified linkages satisfy untagged ~a import multiple times" + (car (siginfo-names (link-record-siginfo import))))) + src)] + [there? + (loop (cdr unit-imports))] + [else + (let ([there?2 (hash-table-get sig-table + (car ctime-ids) + (λ () #f))]) + (cond + [(eq? 'duplicate there?2) + (raise-stx-err + (if tag + (format "Multiple linkages satisfy (tag ~a ~a) import" + tag (car (siginfo-names (link-record-siginfo import)))) + (format "Multiple linkages satisfy untagged ~a import" + (car (siginfo-names (link-record-siginfo import))))) + src)] + [there?2 + (for-each + (λ (cid) + (hash-table-put! linked-sigs-table + (cons tag cid) + #t)) + ctime-ids) + (cons (make-link-record (link-record-tag import) + there?2 + (link-record-sigid import) + (link-record-siginfo import)) + (loop (cdr unit-imports)))] + [else + (raise-stx-err + (if tag + (format "No linkages satisfy (tag ~a ~a) import" + tag (car (siginfo-names (link-record-siginfo import)))) + (format "No linkages satisfy untagged ~a import" + (car (siginfo-names (link-record-siginfo import))))) + src)]))]))])))) + + (define (unprocess-link-record-bind lr) + (if (link-record-tag lr) + #`(#,(link-record-linkid lr) : (tag #,(link-record-tag lr) #,(link-record-sigid lr))) + #`(#,(link-record-linkid lr) : #,(link-record-sigid lr)))) + + (define (unprocess-link-record-use lr) + (if (link-record-tag lr) + #`(tag #,(link-record-tag lr) #,(link-record-linkid lr)) + (link-record-linkid lr))) + + (define (make-id-mappers . unbox-stxes) + (apply values (map make-id-mapper unbox-stxes))) + + (define (make-id-mapper unbox-stx) + (make-set!-transformer + (lambda (sstx) + (syntax-case sstx (set!) + [x + (identifier? #'x) + unbox-stx] + [(set! . x) + (raise-syntax-error + 'unit + "cannot set! imported or exported variables" + sstx)] + [(_ . x) + (datum->syntax-object + sstx + (cons unbox-stx #'x) + sstx)]))))) diff --git a/collects/mzlib/private/unit-keywords.ss b/collects/mzlib/private/unit-keywords.ss new file mode 100644 index 0000000000..779a6616d9 --- /dev/null +++ b/collects/mzlib/private/unit-keywords.ss @@ -0,0 +1,36 @@ +(module unit-keywords mzscheme + (provide (all-defined-except define-syntax-for-error)) + + (define-syntax define-syntax-for-error + (syntax-rules () + ((_ name message) + (begin + (define-syntax name + (make-set!-transformer + (lambda (stx) + (raise-syntax-error + #f + message + stx)))))))) + + (define-syntax-for-error only + "misuse of unit import keyword") + (define-syntax-for-error except + "misuse of unit import keyword") + (define-syntax-for-error prefix + "misuse of unit import and export keyword") + (define-syntax-for-error rename + "misuse of unit import and export keyword") + (define-syntax-for-error tag + "misuse of unit import and export keyword") + (define-syntax-for-error import + "misuse of unit keyword") + (define-syntax-for-error export + "misuse of unit keyword") + (define-syntax-for-error init-depend + "misuse of unit keyword") + (define-syntax-for-error link + "misuse of compound-unit keyword") + (define-syntax-for-error extends + "misuse of define-signature keyword")) + diff --git a/collects/mzlib/private/unit-runtime.ss b/collects/mzlib/private/unit-runtime.ss new file mode 100644 index 0000000000..6b2b32fa6d --- /dev/null +++ b/collects/mzlib/private/unit-runtime.ss @@ -0,0 +1,139 @@ +(module unit-runtime mzscheme + (require-for-syntax "unit-syntax.ss") + (provide define-syntax/err-param + undefined (rename make-a-unit make-unit) unit-import-sigs unit-export-sigs unit-go unit? unit-deps + check-unit check-no-imports check-sigs check-deps check-helper) + + (define-syntax define-syntax/err-param + (syntax-rules () + ((_ (name arg) body) + (define-syntax (name arg) + (parameterize ((error-syntax arg)) + body))))) + + ;; initial value + (define undefined (letrec ([x x]) x)) + + ;; for named structures + (define insp (current-inspector)) + + ;; (make-unit (listof (cons symbol symbol)) (listof (cons symbol symbol)) (listof nat) thunk) + ;; Runtime representation of a unit + (define-struct unit (import-sigs export-sigs deps go)) + + ;; For units with inferred names, generate a struct that prints using the name: + (define (make-naming-constructor type name) + (let-values ([(struct: make- ? -accessor -mutator) + (make-struct-type name type 0 0 #f null insp)]) + make-)) + + ;; Make a unit value (call by the macro expansion of `unit') + (define (make-a-unit name num-imports exports deps go) + ((if name + (make-naming-constructor + struct:unit + (string->symbol (format "unit:~a" name))) + make-unit) + num-imports exports deps go)) + + ;; check-unit : X symbol -> + ;; ensure that u is a unit value + (define (check-unit u name) + (unless (unit? u) + (raise + (make-exn:fail:contract + (string->immutable-string + (format "~a: result of unit expression was not a unit: ~e" name u)) + (current-continuation-marks))))) + + ;; check-helper : (vectorof (cons symbol (vectorof (cons symbol symbol))))) + ; (vectorof (cons symbol (vectorof (cons symbol symbol))))) + ;; symbol symbol -> + ;; ensure that the unit's signatures match the expected signatures. + (define (check-helper sub-sig super-sig name import?) + (define t (make-hash-table 'equal)) + (let loop ([i (sub1 (vector-length sub-sig))]) + (when (>= i 0) + (let ([v (cdr (vector-ref sub-sig i))]) + (let loop ([j (sub1 (vector-length v))]) + (when (>= j 0) + (let ([vj (vector-ref v j)]) + (hash-table-put! t vj + (if (hash-table-get t vj (λ () #f)) + 'amb + #t))) + (loop (sub1 j))))) + (loop (sub1 i)))) + (let loop ([i (sub1 (vector-length super-sig))]) + (when (>= i 0) + (let* ([v0 (vector-ref (cdr (vector-ref super-sig i)) 0)] + [r (hash-table-get t v0 (λ () #f))]) + (when (or (eq? r 'amb) (not r)) + (let ([tag (if (pair? v0) (car v0) #f)] + [sub-name (car (vector-ref super-sig i))] + [err-str (if r + "supplies multiple times" + "does not supply")]) + (raise + (make-exn:fail:contract + (string->immutable-string + (cond + [(and import? tag) + (format "~a: unit argument expects an import for tag ~a with signature ~a, which this usage context ~a" + name + tag + sub-name + err-str)] + [import? + (format "~a: unit argument expects an untagged import with signature ~a, which this usage context ~a" + name + sub-name + err-str)] + [tag + (format "~a: this usage context expects a unit with an export for tag ~a with signature ~a, which the given unit ~a" + name + tag + sub-name + err-str)] + [else + (format "~a: this usage context expects a unit with an untagged export with signature ~a, which the given unit ~a" + name + sub-name + err-str)])) + (current-continuation-marks)))))) + (loop (sub1 i))))) + + ;; check-deps : (hash-tableof (cons symbol (or symbol #f)) (cons symbol symbol)) unit symbol -> + ;; The hash table keys are the tag and runtime signature id + ;; The values are the name of the signature and the linkage + (define (check-deps dep-table unit name) + (for-each + (λ (dep) + (define r (hash-table-get dep-table dep (λ () #f))) + (when r + (raise + (make-exn:fail:contract + (string->immutable-string + (if (car dep) + (format "~a: initialization dependent signature ~a with tag ~a is supplied from a later unit with link ~a" + name (car r) (car dep) (cdr r)) + (format "~a: untagged initialization dependent signature ~a is supplied from a later unit with link ~a" + name (car r) (cdr r)))) + (current-continuation-marks))))) + (unit-deps unit))) + + ;; check-no-imports : unit symbol -> + ;; ensures that the unit has no imports + (define (check-no-imports unit name) + (check-helper (vector) (unit-import-sigs unit) name #t)) + + ;; check-sigs : unit + ;; (vectorof (cons symbol (vectorof (cons symbol symbol))))) + ;; (vectorof (cons symbol (vectorof (cons symbol symbol))))) + ;; symbol -> + ;; ensures that unit has the given signatures + (define (check-sigs unit expected-imports expected-exports name) + (check-helper expected-imports (unit-import-sigs unit) name #t) + (check-helper (unit-export-sigs unit) expected-exports name #f))) + + diff --git a/collects/mzlib/private/unit-syntax.ss b/collects/mzlib/private/unit-syntax.ss new file mode 100644 index 0000000000..d2b62d5259 --- /dev/null +++ b/collects/mzlib/private/unit-syntax.ss @@ -0,0 +1,286 @@ +(module unit-syntax mzscheme + (require (lib "stx.ss" "syntax")) + (require-for-template "unit-keywords.ss") + + (provide (all-defined)) + + (define error-syntax (make-parameter #f)) + (define raise-stx-err + (case-lambda + ((msg) (raise-syntax-error #f msg (error-syntax))) + ((msg stx) (raise-syntax-error #f msg (error-syntax) stx)))) + + ;; check-id: syntax-object -> identifier + (define (check-id id) + (unless (identifier? id) + (raise-stx-err "not an identifier" id)) + id) + + ;; checked-syntax->list : syntax-object -> (listof syntax-object) + (define (checked-syntax->list s) + (define l (syntax->list s)) + (unless (or (stx-pair? s) (stx-null? s)) + (raise-stx-err "bad syntax (not a list)" s)) + (unless l + (raise-stx-err "bad syntax (illegal use of `.')" s)) + l) + + ;; check-tagged : (syntax-object -> X) -> syntax-object -> (cons (or symbol #f) X) + (define (check-tagged check) + (λ (o) + (syntax-case o (tag) + ((tag . s) + (syntax-case #'s () + ((sym spec) + (begin + (unless (symbol? (syntax-e #'sym)) + (raise-stx-err "tag must be a symbol" #'sym)) + (cons (syntax-e #'sym) (check #'spec)))) + (_ (raise-stx-err "expected (tag )" #'s)))) + (_ + (cons #f (check o)))))) + + ;; check-tagged-:-clause : syntax-object -> (cons identifier identifier) + ;; ensures that clause matches (a : b) or (a : (tag t b)) + (define (check-tagged-:-clause clause) + (checked-syntax->list clause) + (syntax-case* clause (:) (lambda (x y) (eq? (syntax-e x) (syntax-e y))) + ((a : b) + (identifier? #'a) + (let ([p ((check-tagged check-id) #'b)]) + (cons (car p) (cons #'a (cdr p))))) + (_ (raise-stx-err + "expected syntax matching ( : ) or ( : (tag ))" + clause)))) + + (define check-tagged-id (check-tagged check-id)) + + ;; check-spec-syntax : syntax-object boolean (syntax-object -> boolean) -> + ;; ensures that s matches spec. + ;; tag-spec ::= spec + ;; | (tag symbol spec) + ;; spec ::= prim-spec + ;; | (prefix identifier spec) + ;; | (rename spec (identifier identifier) ...) + ;; | (only spec identifier ...) only if import? is true + ;; | (except spec identifier ...) only if import? is true + (define (check-tagged-spec-syntax s import? prim-spec?) + ((check-tagged (λ (s) (check-spec-syntax s import? prim-spec?))) s)) + + (define (check-spec-syntax s import? prim-spec?) + (unless (prim-spec? s) + (let ((ie (if import? 'import 'export))) + (unless (stx-pair? s) + (raise-stx-err (format "bad ~a spec" ie) s)) + (checked-syntax->list s) + (syntax-case s (prefix rename) + ((key . x) + (or (module-identifier=? #'key #'only) + (module-identifier=? #'key #'except)) + (begin + (unless import? + (raise-stx-err + "bad export-spec keyword" + #'key)) + (syntax-case #'x () + (() + (raise-stx-err (format "missing ~a-spec argument" ie) + s)) + ((s y ...) + (begin + (for-each check-id (syntax->list #'(y ...))) + (check-spec-syntax #'s import? prim-spec?)))))) + ((prefix) + (raise-stx-err (format "missing prefix identifier and ~a spec" ie) + s)) + ((prefix x) + (begin + (check-id #'x) + (raise-stx-err (format "missing ~a spec" ie) s))) + ((prefix x y) + (begin + (check-id #'x) + (check-spec-syntax #'y import? prim-spec?))) + ((prefix . _) + (raise-stx-err "too many arguments" s)) + ((rename) + (raise-stx-err (format "missing ~a spec" ie) s)) + ((rename sub-s clause ...) + (begin + (for-each + (lambda (c) + (syntax-case c () + ((a b) + (begin + (check-id #'a) + (check-id #'b))) + ((a . b) + (begin + (checked-syntax->list c) + (raise-stx-err "bad rename clause" c))) + (_ + (raise-stx-err "bad rename clause" c)))) + (syntax->list #'(clause ...))) + (check-spec-syntax #'sub-s import? prim-spec?))) + ((k . x) + (raise-stx-err (format "bad ~a-spec keyword" ie) #'k)))))) + + ;; check-unit-syntax : syntax-object -> syntax-object + ;; ensures that stx matches ((import i ...) (export e ...) b ...) + ;; or ((import i ...) (export e ...) (init-depend id ...) b ...) + ;; and returns syntax that matches the latter + (define (check-unit-syntax stx) + (syntax-case stx (import export init-depend) + (((import . isig) (export . esig) (init-depend . id) . body) + (begin + (checked-syntax->list (stx-car stx)) + (checked-syntax->list (stx-car (stx-cdr stx))) + (checked-syntax->list (stx-car (stx-cdr (stx-cdr stx)))) + (checked-syntax->list #'body) + stx)) + (((import . isig) (export . esig) . body) + (begin + (checked-syntax->list (stx-car stx)) + (checked-syntax->list (stx-car (stx-cdr stx))) + (checked-syntax->list #'body) + (syntax/loc stx + ((import . isig) (export . esig) (init-depend) . body)))) + (() + (raise-stx-err "missing import and export clauses")) + (((import . isig)) + (raise-stx-err "missing export clause")) + (((import . isig) e . rest) + (raise-stx-err "export clause must start with keyword \"export\"" #'e)) + ((i . rest) + (raise-stx-err "import clause must start with keyword \"import\"" #'i)))) + + + ;; check-unit-body-syntax : syntax-object -> syntax-object + ;; ensures that stx matches (exp (import i ...) (export e ...)) + ;; or (exp (import i ...) (export e ...) (init-depend id ...)) + ;; and returns syntax that matches the latter + (define (check-unit-body-syntax stx) + (checked-syntax->list stx) + (syntax-case stx (import export init-depend) + ((exp (import . isig) (export . esig) (init-depend . id)) + (begin + (checked-syntax->list (stx-car (stx-cdr stx))) + (checked-syntax->list (stx-car (stx-cdr (stx-cdr stx)))) + (checked-syntax->list (stx-car (stx-cdr (stx-cdr (stx-cdr stx))))) + stx)) + ((exp (import . isig) (export . esig)) + (begin + (checked-syntax->list (stx-car (stx-cdr stx))) + (checked-syntax->list (stx-car (stx-cdr (stx-cdr stx)))) + (syntax/loc stx + (exp (import . isig) (export . esig) (init-depend))))) + (() + (raise-stx-err "missing expression, import and export clauses")) + ((exp) + (raise-stx-err "missing import and export clauses")) + ((exp (import . isig)) + (raise-stx-err "missing export clause")) + ((exp i e id extra . rest) + (raise-stx-err "too many clauses" stx)) + ((exp (import . isig) (export . esig) id) + (raise-stx-err "init-depend clause must start with keyword \"init-depend\"" #'id)) + ((exp (import . isig) e . rest) + (raise-stx-err "export clause must start with keyword \"export\"" #'e)) + ((exp i . rest) + (raise-stx-err "import clause must start with keyword \"import\"" #'i)))) + + + + + ;; check-link-line-syntax : syntax-object -> + ;; ensures that l matches ((x ...) u y ...) + (define (check-link-line-syntax l) + (unless (stx-pair? l) + (raise-stx-err "bad linking line" l)) + (checked-syntax->list l) + (syntax-case l () + (((x ...) u y ...) (void)) + (((x ...)) + (raise-stx-err "missing unit expression" l)) + ((x . y) + (begin + (unless (stx-pair? #'x) + (raise-stx-err "bad export list" #'x)) + (checked-syntax->list #'x))))) + + ;; check-compound-syntax : syntax-object -> syntax-object + ;; ensures that clauses has exactly one clause matching each of + ;; (import i ...), (export e ...), and (link i ...), in any order. + ;; returns #'((i ...) (e ...) (l ...)) + (define (check-compound-syntax c) + (define clauses (checked-syntax->list c)) + (define im #f) + (define ex #f) + (define li #f) + (for-each + (lambda (clause) + (syntax-case clause (import export link) + ((import i ...) + (begin + (when im + (raise-stx-err "multiple import clauses" clause)) + (set! im (syntax->list #'(i ...))))) + ((export e ...) + (begin + (when ex + (raise-stx-err "multiple export clauses" clause)) + (set! ex (syntax->list #'(e ...))))) + ((link l ...) + (begin + (when li + (raise-stx-err "duplicate link clauses" clause)) + (set! li (syntax->list #'(l ...))))) + ((x . y) + (begin + (checked-syntax->list clause) + (raise-stx-err "bad compound-unit clause keyword" #'x))) + (_ + (raise-stx-err "expected import, export, or link clause" clause)))) + clauses) + (unless im + (raise-stx-err "missing import clause")) + (unless ex + (raise-stx-err "missing export clause")) + (unless li + (raise-stx-err "missing link clause" )) + #`(#,im #,ex #,li)) + + ;; check-def-syntax : syntax-object -> + ;; d must be a syntax-pair + ;; ensures that d matches (_ (x ...) e) + (define (check-def-syntax d) + (unless (syntax->list d) + (raise-syntax-error + #f + "bad syntax (illegal use of `.')" + d)) + (syntax-case d () + ((_ params expr) + (let ((l (syntax->list #'params))) + (unless l + (raise-syntax-error + #f + "bad variable list" + d #'params)) + (for-each + (lambda (x) + (unless (identifier? x) + (raise-syntax-error + #f + "not an identifier" + d x))) + l))) + (_ + (raise-syntax-error + #f + (format "bad syntax (has ~a parts after keyword)" + (sub1 (length (syntax->list d)))) + d)))) + ) + +;(load "test-unit-syntax.ss") \ No newline at end of file diff --git a/collects/mzlib/unit-exptime.ss b/collects/mzlib/unit-exptime.ss new file mode 100644 index 0000000000..3a6be5766b --- /dev/null +++ b/collects/mzlib/unit-exptime.ss @@ -0,0 +1,26 @@ +(module unit-exptime mzscheme + (require "private/unit-syntax.ss" + "private/unit-compiletime.ss") + + (provide unit-static-signatures + signature-members) + + (define (unit-static-signatures name err-stx) + (parameterize ((error-syntax err-stx)) + (let ((ui (lookup-def-unit name))) + (values (apply list-immutable (unit-info-import-sig-ids ui)) + (apply list-immutable (unit-info-export-sig-ids ui)))))) + + (define (signature-members name err-stx) + (parameterize ((error-syntax err-stx)) + (let ([s (lookup-signature name)]) + (values + ;; extends: + (and (pair? (cdr (siginfo-names (signature-siginfo s)))) + (cadr (siginfo-names (signature-siginfo s)))) + ;; vars + (apply list-immutable (signature-vars s)) + ;; defined vars + (apply list-immutable (apply append (map car (signature-val-defs s)))) + ;; defined stxs + (apply list-immutable (apply append (map car (signature-stx-defs s))))))))) diff --git a/collects/mzlib/unit.ss b/collects/mzlib/unit.ss index 67f90e5302..f5e201c120 100644 --- a/collects/mzlib/unit.ss +++ b/collects/mzlib/unit.ss @@ -1,869 +1,1620 @@ - -;; Unit system - (module unit mzscheme - (require-for-syntax (lib "kerncase.ss" "syntax") - (lib "stx.ss" "syntax") - (lib "name.ss" "syntax") - (lib "context.ss" "syntax") - "list.ss" - "private/unitidmap.ss") - - ;; ---------------------------------------------------------------------- - ;; Structures and helpers - - (define undefined (letrec ([x x]) x)) ; initial value - - (define insp (current-inspector)) ; for named structures - - (define-struct unit (num-imports exports go)) ; unit value - (define-struct (exn:fail:unit exn:fail) ()) ; run-time exception - - ;; For units with inferred names, generate a struct that prints using the name: - (define (make-naming-constructor type name) - (let-values ([(struct: make- ? -accessor -mutator) - (make-struct-type name type 0 0 #f null insp)]) - make-)) - - ;; Make a unt value (call by the macro expansion of `unit') - (define (make-a-unit name num-imports exports go) - ((if name - (make-naming-constructor - struct:unit - (string->symbol (format "unit:~a" name))) - make-unit) - num-imports exports go)) - - ;; ---------------------------------------------------------------------- - ;; The `unit' syntactic form - - (define-syntaxes (_unit unit/no-expand) - (let ([do-unit - (lambda (stx expand?) - (syntax-case stx (import export) - [(_ (import ivar ...) - (export evar ...) - defn&expr ...) - (let ([check-id (lambda (v) - (unless (identifier? v) - (raise-syntax-error - #f - "import is not an identifier" - stx - v)))] - [check-renamed-id - (lambda (v) - (syntax-case v () - [id (identifier? (syntax id)) (list v)] - [(lid eid) (and (identifier? (syntax lid)) - (identifier? (syntax eid))) - (list #'lid #'eid)] - [else (raise-syntax-error - #f - "export is not an identifier or renamed identifier" - stx - v)]))] - [expand-context (generate-expand-context)] - [def-ctx (and expand? - (syntax-local-make-definition-context))] - [localify (lambda (ids def-ctx) - (if (andmap identifier? ids) - ;; In expand mode, add internal defn context - (if expand? - (begin - ;; Treat imports as internal-defn names: - (syntax-local-bind-syntaxes ids #f def-ctx) - (cdr (syntax->list - (local-expand #`(stop #,@ids) - 'expression - (list #'stop) - def-ctx)))) - ids) - ;; Let later checking report an error: - ids))]) - (let ([ivars (localify (syntax->list (syntax (ivar ...))) def-ctx)] - [evars (syntax->list (syntax (evar ...)))]) - (for-each check-id ivars) - (for-each check-renamed-id evars) - - ;; Get import/export declared names: - (let* ([exported-names - (localify - (map (lambda (v) - (syntax-case v () - [(lid eid) (syntax lid)] - [id (syntax id)])) - evars) - def-ctx)] - [extnames (map (lambda (v) - (syntax-case v () - [(lid eid) (syntax eid)] - [id (syntax id)])) - evars)] - [imported-names ivars] - [declared-names (append imported-names exported-names)]) - ;; Check that all exports are distinct (as symbols) - (let ([ht (make-hash-table)]) - (for-each (lambda (name) - (when (hash-table-get ht (syntax-e name) #f) - (raise-syntax-error - #f - "duplicate export" - stx - name)) - (hash-table-put! ht (syntax-e name) #t)) - extnames)) - - ;; Expand all body expressions - ;; so that all definitions are exposed. - (letrec ([expand-all - (if expand? - (lambda (defns&exprs) - (apply - append - (map - (lambda (defn-or-expr) - (let ([defn-or-expr - (local-expand - defn-or-expr - expand-context - (append - (kernel-form-identifier-list (quote-syntax here)) - declared-names) - def-ctx)]) - (syntax-case defn-or-expr (begin define-values define-syntaxes) - [(begin . l) - (let ([l (syntax->list (syntax l))]) - (unless l - (raise-syntax-error - #f - "bad syntax (illegal use of `.')" - defn-or-expr)) - (expand-all (map (lambda (s) - (syntax-track-origin s defn-or-expr #'begin)) - l)))] - [(define-syntaxes (id ...) rhs) - (andmap identifier? (syntax->list #'(id ...))) - (with-syntax ([rhs (local-transformer-expand - #'rhs - 'expression - null)]) - (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #'rhs def-ctx) - (list #'(define-syntaxes (id ...) rhs)))] - [(define-values (id ...) rhs) - (andmap identifier? (syntax->list #'(id ...))) - (begin - (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #f def-ctx) - (list defn-or-expr))] - [else (list defn-or-expr)]))) - defns&exprs))) - values)]) - (let ([all-expanded (expand-all (syntax->list (syntax (defn&expr ...))))]) - ;; Get all the defined names, sorting out variable definitions - ;; from syntax definitions. - (let* ([definition? - (lambda (id) - (and (identifier? id) - (or (module-identifier=? id (quote-syntax define-values)) - (module-identifier=? id (quote-syntax define-syntaxes)))))] - [all-defined-names/kinds - (apply - append - (map - (lambda (defn-or-expr) - (syntax-case defn-or-expr (define-values define-syntaxes) - [(dv (id ...) expr) - (definition? (syntax dv)) - (let ([l (syntax->list (syntax (id ...)))]) - (for-each (lambda (i) - (unless (identifier? i) - (raise-syntax-error - #f - "not an identifier in definition" - defn-or-expr - i))) - l) - (let ([key (if (module-identifier=? (syntax dv) (quote-syntax define-syntaxes)) - 'stx - 'val)]) - (map (lambda (id) (cons key id)) l)))] - [(define-values . l) - (raise-syntax-error - #f - "bad definition form" - defn-or-expr)] - [(define-syntaxes . l) - (raise-syntax-error - #f - "bad syntax definition form" - defn-or-expr)] - [else null])) - all-expanded))] - [all-defined-names (map cdr all-defined-names/kinds)] - [all-defined-val-names (map cdr - (filter (lambda (i) (eq? (car i) 'val)) - all-defined-names/kinds))]) - ;; Check that all defined names (var + stx) are distinct: - (let ([name (check-duplicate-identifier - (append imported-names all-defined-names))]) - (when name - (raise-syntax-error - #f - "variable imported and/or defined twice" - stx - name))) - ;; Check that all exported names are defined (as var): - (let ([ht (make-hash-table)] - [stx-ht (make-hash-table)]) - (for-each - (lambda (kind+name) - (let ([name (cdr kind+name)]) - (let ([l (hash-table-get ht (syntax-e name) null)]) - (hash-table-put! (if (eq? (car kind+name) 'val) ht stx-ht) - (syntax-e name) - (cons name l))))) - all-defined-names/kinds) - (for-each - (lambda (n) - (let ([v (hash-table-get ht (syntax-e n) null)]) - (unless (ormap (lambda (i) (bound-identifier=? i n)) v) - ;; Either not defined, or defined as syntax: - (let ([stx-v (hash-table-get stx-ht (syntax-e n) null)]) - (if (ormap (lambda (i) (bound-identifier=? i n)) stx-v) - (raise-syntax-error - #f - "cannot export syntax from a unit" - stx - n) - (raise-syntax-error - #f - "exported variable is not defined" - stx - n)))))) - exported-names)) - - ;; Compute defined but not exported: - (let ([ht (make-hash-table)]) - (for-each - (lambda (name) - (let ([l (hash-table-get ht (syntax-e name) null)]) - (hash-table-put! ht (syntax-e name) (cons name l)))) - exported-names) - (let ([internal-names - (let loop ([l all-defined-val-names]) - (cond - [(null? l) null] - [(let ([v (hash-table-get ht (syntax-e (car l)) null)]) - (ormap (lambda (i) (bound-identifier=? i (car l))) v)) - (loop (cdr l))] - [else (cons (car l) (loop (cdr l)))]))]) - ;; Generate names for import/export boxes, etc: - (with-syntax ([(ivar ...) ivars] - [(iloc ...) (generate-temporaries ivars)] - [(eloc ...) (generate-temporaries evars)] - [(extname ...) extnames] - [(expname ...) exported-names] - [(intname ...) internal-names]) - ;; Change all definitions to set!s. Convert evars to set-box!, - ;; because set! on exported variables is not allowed. - (with-syntax ([(defn&expr ...) - (let ([elocs (syntax->list (syntax (eloc ...)))]) - (filter - values - (map (lambda (defn-or-expr) - (syntax-case defn-or-expr (define-values define-syntaxes) - [(define-values ids expr) - (let* ([ids (syntax->list (syntax ids))]) - (if (null? ids) - (syntax/loc defn-or-expr (set!-values ids expr)) - (let ([do-one - (lambda (id tmp name) - (let loop ([evars exported-names] - [elocs elocs]) - (cond - [(null? evars) - ;; not an exported id - (with-syntax ([id id][tmp tmp]) - (syntax/loc - defn-or-expr - (set! id tmp)))] - [(bound-identifier=? (car evars) id) - ;; set! exported id: - (with-syntax - ([loc (car elocs)] - [tmp - (if name - (with-syntax - ([tmp tmp] - [name name]) - (syntax - (let ([name tmp]) - name))) - tmp)]) - (syntax/loc defn-or-expr - (set-box! loc tmp)))] - [else (loop (cdr evars) - (cdr elocs))])))]) - (if (null? (cdr ids)) - (do-one (car ids) (syntax expr) (car ids)) - (let ([tmps (generate-temporaries ids)]) - (with-syntax ([(tmp ...) tmps] - [(set ...) - (map (lambda (id tmp) - (do-one id tmp #f)) - ids tmps)]) - (syntax/loc defn-or-expr - (let-values ([(tmp ...) expr]) - set ...))))))))] - [(define-syntaxes . l) #f] - [else defn-or-expr])) - all-expanded)))] - [(stx-defn ...) - (filter - values - (map (lambda (defn-or-expr) - (syntax-case defn-or-expr (define-syntaxes) - [(define-syntaxes . l) #'l] - [else #f])) - all-expanded))]) - ;; Build up set! redirection chain: - (with-syntax ([redirections - (let ([varlocs - (syntax->list - (syntax ((ivar iloc) ... (expname eloc) ...)))]) - (with-syntax ([vars (map stx-car varlocs)] - [rhss - (map - (lambda (varloc) - (with-syntax ([(var loc) varloc]) - (syntax - (make-id-mapper (quote-syntax (unbox loc)) - (quote-syntax var))))) - varlocs)]) - (syntax - ([vars (values . rhss)]))))] - [num-imports (datum->syntax-object - (quote-syntax here) - (length (syntax->list (syntax (iloc ...)))) - #f)] - [name (syntax-local-infer-name stx)]) - (syntax/loc stx - (make-a-unit - 'name - num-imports - (list (quote extname) ...) - (lambda () - (let ([eloc (box undefined)] ...) - (list (vector eloc ...) - (lambda (iloc ...) - (letrec-syntaxes+values - (stx-defn ... . redirections) - ([(intname) undefined] ...) - (void) ; in case the body would be empty - defn&expr ...))))))))))))))))))]))]) - (values (lambda (stx) (do-unit stx #t)) - (lambda (stx) (do-unit stx #f))))) - - ;; ---------------------------------------------------------------------- - ;; check-expected-interface: used by the expansion of `compound-unit' + (require-for-syntax (lib "list.ss") + (lib "boundmap.ss" "syntax") + (lib "context.ss" "syntax") + (lib "kerncase.ss" "syntax") + (lib "name.ss" "syntax") + (lib "struct.ss" "syntax") + (lib "stx.ss" "syntax") + "private/unit-compiletime.ss" + "private/unit-syntax.ss") - (define (check-expected-interface tag unit num-imports exports) - (unless (unit? unit) - (raise - (make-exn:fail:unit - (string->immutable-string - (format "compound-unit: result of expression for tag ~s not a unit: ~e" tag unit)) - (current-continuation-marks)))) - (unless (= num-imports (unit-num-imports unit)) - (raise - (make-exn:fail:unit - (string->immutable-string - (format "compound-unit: unit for tag ~s expects ~a imports, given ~a" - tag - (unit-num-imports unit) - num-imports)) - (current-continuation-marks)))) - (list->vector - (map (lambda (ex) - (let loop ([l (unit-exports unit)][i 0]) - (cond - [(null? l) - (raise - (make-exn:fail:unit - (string->immutable-string - (format "compound-unit: unit for tag ~s has no ~s export" - tag ex)) - (current-continuation-marks)))] - [(eq? (car l) ex) - i] - [else (loop (cdr l) (add1 i))]))) - exports))) - - ;; ---------------------------------------------------------------------- - ;; The `compound-unit' syntactic form - - (define-syntax compound-unit - (lambda (stx) - (syntax-case stx (import export link) - [(_ (import ivar ...) - (link [tag (unit-expr linkage ...)] ...) - (export exportage ...)) - (let ([check-id (lambda (v) - (unless (identifier? v) - (raise-syntax-error - #f - "import is not an identifier" - stx - v)))] - [check-tag (lambda (v) - (unless (identifier? v) - (raise-syntax-error - #f - "tag is not an identifier" - stx - v)))] - [check-linkage (lambda (v) - (syntax-case v () - [id (identifier? (syntax id)) #t] - [(tag id ...) - (for-each (lambda (v) - (unless (identifier? v) - (raise-syntax-error - #f - "non-identifier in linkage" - stx - v))) - (syntax->list v))] - [else - (raise-syntax-error - #f - "ill-formed linkage" - stx - v)]))] - [check-exportage (lambda (v) - (syntax-case v () - [(tag ex ...) - (begin - (unless (identifier? (syntax tag)) - (raise-syntax-error - #f - "export tag is not an identifier" - stx - (syntax tag))) - (for-each - (lambda (e) - (syntax-case e () - [id (identifier? (syntax id)) #t] - [(iid eid) - (begin - (unless (identifier? (syntax iid)) - (raise-syntax-error - #f - "export internal name is not an identifier" - stx - (syntax iid))) - (unless (identifier? (syntax eid)) - (raise-syntax-error - #f - "export internal name is not an identifier" - stx - (syntax eid))))] - [else - (raise-syntax-error - #f - (format "ill-formed export with tag ~a" - (syntax-e (syntax tag))) - stx - e)])) - (syntax->list (syntax (ex ...)))))] - [else - (raise-syntax-error - #f - "ill-formed export" - stx - v)]))] - [imports (syntax->list (syntax (ivar ...)))] - [tags (syntax->list (syntax (tag ...)))] - [linkages (map syntax->list (syntax->list (syntax ((linkage ...) ...))))] - [exports (syntax->list (syntax (exportage ...)))]) - ;; Syntax checks: - (for-each check-id imports) - (for-each check-tag tags) - (for-each (lambda (l) (for-each check-linkage l)) linkages) - (for-each check-exportage exports) - ;; Check for duplicate imports - (let ([dup (check-duplicate-identifier imports)]) - (when dup - (raise-syntax-error - #f - "duplicate import" - stx - dup))) - ;; Check for duplicate tags - (let ([dup (check-duplicate-identifier tags)]) - (when dup - (raise-syntax-error - #f - "duplicate tag" - stx - dup))) - ;; Check referenced imports and tags - (let ([check-linkage-refs (lambda (v) - (syntax-case v () - [(tag . exs) - (unless (ormap (lambda (t) - (bound-identifier=? t (syntax tag))) - tags) - (raise-syntax-error - #f - "linkage tag is not bound" - stx - (syntax tag)))] - [id (unless (ormap (lambda (i) - (bound-identifier=? i (syntax id))) - imports) - (raise-syntax-error - #f - "no imported identified for linkage" - stx - (syntax id)))]))] - [check-export-refs (lambda (v) - (syntax-case v () - [(tag . r) - (unless (ormap (lambda (t) - (bound-identifier=? t (syntax tag))) - tags) - (raise-syntax-error - #f - "export tag is not bound" - stx - (syntax tag)))]))]) - (for-each (lambda (l) (for-each check-linkage-refs l)) - linkages) - (for-each check-export-refs exports) - ;; Get all export names, and check for duplicates - (let ([export-names - (apply - append - (map - (lambda (v) - (syntax-case v () - [(tag . exs) - (map - (lambda (e) - (syntax-case e () - [(iid eid) (syntax eid)] - [id e])) - (syntax->list (syntax exs)))])) - exports))]) - (let ([dup (check-duplicate-identifier export-names)]) - (when dup - (raise-syntax-error - #f - "duplicate export" - stx - dup))) - - (let ([constituents (generate-temporaries tags)] - [unit-export-positionss (generate-temporaries tags)] - [unit-setups (generate-temporaries tags)] - [unit-extracts (generate-temporaries tags)] - [unit-export-lists - ;; For each tag, get all expected exports - (let* ([hts (map (lambda (x) (make-hash-table)) tags)] - [get-add-name - (lambda (tag) - (ormap (lambda (t ht) - (and (bound-identifier=? t tag) - (lambda (name) - (hash-table-put! ht (syntax-e name) name)))) - tags hts))]) - ;; Walk though linkages - (for-each - (lambda (linkage-list) - (for-each - (lambda (linkage) - (syntax-case linkage () - [(tag . ids) - (let ([add-name (get-add-name (syntax tag))]) - (for-each add-name (syntax->list (syntax ids))))] - [else (void)])) - linkage-list)) - linkages) - ;; Walk through exports - (for-each - (lambda (v) - (syntax-case v () - [(tag . exs) - (let ([add-name (get-add-name (syntax tag))]) - (for-each - (lambda (e) - (syntax-case e () - [(iid eid) (add-name (syntax iid))] - [id (add-name (syntax id))])) - (syntax->list (syntax exs))))])) - exports) - ;; Extract names from hash tables - (map (lambda (ht) - (hash-table-map ht (lambda (k v) v))) - hts))]) - ;; Map exports to imports and indices based on expected unit exports - (let ([map-tag (lambda (t l) - (let loop ([tags tags][l l]) - (if (bound-identifier=? (car tags) t) - (car l) - (loop (cdr tags) (cdr l)))))] - [unit-export-hts (map (lambda (export-list) - (let ([ht (make-hash-table)]) - (let loop ([l export-list][p 0]) - (unless (null? l) - (hash-table-put! ht (syntax-e (car l)) p) - (loop (cdr l) (add1 p)))) - ht)) - unit-export-lists)] - [interned-integer-lists null] - [interned-id-lists null]) - (let ([make-mapping - (lambda (v) - (syntax-case v () - [(tag . exs) - (let ([extract (map-tag (syntax tag) - unit-extracts)] - [ht (map-tag (syntax tag) - unit-export-hts)]) - (with-syntax ([extract extract] - [pos-name - (let ([il - (map - (lambda (e) - (hash-table-get - ht - (syntax-e - (syntax-case e () - [(iid eid) (syntax iid)] - [id e])))) - (syntax->list (syntax exs)))]) - (or (ormap (lambda (i) - (and (equal? il (cadadr i)) - (car i))) - interned-integer-lists) - (let ([name (car (generate-temporaries - (list (syntax tag))))]) - (set! interned-integer-lists - (cons `(,name ',il) - interned-integer-lists)) - name)))]) - (syntax (map extract pos-name))))] - [import v]))] - [collapse (lambda (l) - (let loop ([l l]) - (cond - [(null? l) null] - [(identifier? (car l)) - (let-values ([(ids rest) - (let loop ([l l][ids null]) - (if (or (null? l) - (not (identifier? (car l)))) - (values (reverse ids) l) - (loop (cdr l) (cons (car l) ids))))]) - (let ([name - (let ([id-syms (map syntax-e ids)]) - (or (ormap (lambda (i) - (and (equal? id-syms (cadr i)) - (car i))) - interned-id-lists) - (let ([name - (car (generate-temporaries (list 'ids)))]) - (set! interned-id-lists - (cons (list* name id-syms ids) - interned-id-lists)) - name)))]) - (cons name - (loop rest))))] - [else (cons (car l) (loop (cdr l)))])))]) - (let ([export-mapping (collapse (map make-mapping exports))] - [import-mappings (map (lambda (linkage-list) - (collapse - (map make-mapping linkage-list))) - linkages)]) - (with-syntax ([(constituent ...) constituents] - [(unit-export-positions ...) unit-export-positionss] - [(unit-setup ...) unit-setups] - [(unit-extract ...) unit-extracts] - [interned-integer-lists interned-integer-lists] - [interned-id-lists (map (lambda (i) - (with-syntax ([name (car i)] - [ids (cddr i)]) - (syntax [name (list . ids)]))) - interned-id-lists)] - [(unit-export-list ...) unit-export-lists] - [(import-mapping ...) import-mappings] - [(unit-import-count ...) - (map (lambda (l) - (datum->syntax-object - (quote-syntax here) - (apply - + - (map (lambda (v) - (if (identifier? v) - 1 - (length (cdr (syntax->list v))))) - l)) - #f)) - linkages)] - [num-imports (datum->syntax-object - (quote-syntax here) - (length imports) - #f)] - [export-names export-names] - [export-mapping export-mapping] - [name (syntax-local-infer-name stx)]) - (syntax/loc - stx - (let ([constituent unit-expr] - ...) - (let ([unit-export-positions - (check-expected-interface - 'tag - constituent - unit-import-count - 'unit-export-list)] - ...) - (make-a-unit - 'name - num-imports - (quote export-names) - (lambda () - (let ([unit-setup ((unit-go constituent))] ...) - (let ([unit-extract - (lambda (pos) - (vector-ref (car unit-setup) - (vector-ref unit-export-positions pos)))] - ... - . - interned-integer-lists) - (list (list->vector (append . export-mapping)) - (lambda (ivar ...) - (let interned-id-lists - (void) ;; in case there are no units - (apply (list-ref unit-setup 1) - (append . import-mapping)) - ...))))))))))))))))))]))) - - ;; ---------------------------------------------------------------------- - ;; check-unit: used by the expansion of `invoke-unit' + (require (lib "etc.ss") + "private/unit-keywords.ss" + "private/unit-runtime.ss" + (only "private/unit-compiletime.ss" apply-mac)) - (define (check-unit u n) - (unless (unit? u) - (raise - (make-exn:fail:unit - (string->immutable-string - (format "invoke-unit: result of unit expression was not a unit: ~e" u)) - (current-continuation-marks)))) - (unless (= (unit-num-imports u) n) - (raise - (make-exn:fail:unit - (string->immutable-string - (format "invoke-unit: expected a unit with ~a imports, given one with ~a imports" - n (unit-num-imports u))) - (current-continuation-marks))))) - - ;; ---------------------------------------------------------------------- - ;; The `invoke-unit' syntactic form + (provide define-signature-form struct open + define-signature provide-signature-elements + only except rename import export prefix link tag init-depend extends + unit? + (rename :unit unit) define-unit + compound-unit define-compound-unit compound-unit/infer define-compound-unit/infer + invoke-unit define-values/invoke-unit + invoke-unit/infer define-values/invoke-unit/infer + unit-from-context define-unit-from-context + define-unit-binding + unit/new-import-export define-unit/new-import-export) + + (define-syntax/err-param (define-signature-form stx) + (syntax-case stx () + ((_ (name arg) . val) + (begin + (check-id #'name) + (check-id #'arg) + #'(define-syntax name + (make-set!-transformer + (make-signature-form (λ (arg) . val)))))) + ((_ . l) + (let ((l (checked-syntax->list stx))) + (unless (>= 3 (length l)) + (raise-stx-err + (format "expected syntax matching (~a (id id) expr ...)" + (syntax-e (stx-car stx))))) + (unless (= 2 (length (checked-syntax->list (car l)))) + (raise-stx-err + "expected syntax matching (identifier identifier)" + (car l))))))) - (define-syntax invoke-unit - (lambda (stx) - (syntax-case stx (import export) - [(_ unit-expr expr ...) - (let ([exprs (syntax (expr ...))]) - (with-syntax ([(bx ...) (generate-temporaries (syntax (expr ...)))] - [num (datum->syntax-object - (quote-syntax here) - (length (syntax->list exprs)) - #f)]) - (syntax/loc - stx - (let ([u unit-expr]) - (check-unit u num) - (let ([bx (box expr)] ...) - ((list-ref ((unit-go u)) 1) - bx ...))))))]))) + (define-signature-form (struct stx) + (parameterize ((error-syntax stx)) + (syntax-case stx () + ((_ name (field ...) . omissions) + (let ([omit-selectors #f] + [omit-setters #f] + [omit-constructor #f] + [omit-type #f]) + (define (remove-ctor&type-name l) + (cond + ((and omit-constructor omit-type) + (cddr l)) + (omit-type + (cdr l)) + (omit-constructor + (cons (car l) (cddr l))) + (else + l))) + (define (remove-ctor&type-info l) + (define new-type + (if omit-type + #f + (cadr l))) + (define new-ctor + (if omit-constructor + #f + (caddr l))) + (cons-immutable (car l) + (cons-immutable new-type + (cons-immutable new-ctor + (cdddr l))))) + (check-id #'name) + (for-each check-id (syntax->list #'(field ...))) + (for-each + (lambda (omission) + (cond + ((and (identifier? omission) + (module-identifier=? omission #'-selectors)) + (set! omit-selectors #t)) + ((and (identifier? omission) + (module-identifier=? omission #'-setters)) + (set! omit-setters #t)) + ((and (identifier? omission) + (module-identifier=? omission #'-constructor)) + (set! omit-constructor #t)) + ((and (identifier? omission) + (module-identifier=? omission #'-type)) + (set! omit-type #t)) + (else + (raise-stx-err + "expected \"-selectors\" or \"-setters\" or \"-constructor\" or \"-type\"" + omission)))) + (checked-syntax->list #'omissions)) + (cons + #`(define-syntaxes (name) + #,(remove-ctor&type-info + (build-struct-expand-info + #'name (syntax->list #'(field ...)) + omit-selectors omit-setters + #f '(#f) '(#f)))) + (remove-ctor&type-name + (build-struct-names #'name (syntax->list #'(field ...)) + omit-selectors omit-setters #f))))) + ((_ name (x . y) . omissions) + ;; Will fail + (checked-syntax->list (stx-car (stx-cdr (stx-cdr stx))))) + ((_ name fields . omissions) + (raise-stx-err "expected syntax matching (identifier ...)" #'fields)) + ((_ name) + (raise-stx-err "missing fields")) + ((_) + (raise-stx-err "missing name and fields"))))) - (define-syntaxes (define-values/invoke-unit - namespace-variable-bind/invoke-unit) - (let ([mk - (lambda (global?) - (lambda (stx) - (syntax-case stx () - [(_ exports unite . prefix+imports) - (let* ([badsyntax (lambda (s why) - (raise-syntax-error - #f - (format "bad syntax (~a)" why) - stx - s))] - [symcheck (lambda (s) - (or (identifier? s) - (badsyntax s "not an identifier")))]) - (unless (stx-list? (syntax exports)) - (badsyntax (syntax exports) "not a sequence of identifiers")) - (for-each symcheck (syntax->list (syntax exports))) - (let ([prefix (if (stx-null? (syntax prefix+imports)) - #f - (stx-car (syntax prefix+imports)))]) - (unless (or (not prefix) - (not (syntax-e prefix)) - (identifier? prefix)) - (badsyntax prefix "prefix is not an identifier")) - (for-each symcheck (let ([v (syntax prefix+imports)]) - (cond - [(stx-null? v) null] - [(stx-list? v) (cdr (syntax->list v))] - [else - (badsyntax (syntax prefix+imports) "illegal use of `.'")]))) - (with-syntax ([(tagged-export ...) - (if (and prefix (syntax-e prefix)) - (let ([prefix (string-append - (symbol->string - (syntax-e prefix)) - ":")]) - (map (lambda (s) - (datum->syntax-object - s - (string->symbol - (string-append - prefix - (symbol->string (syntax-e s)))) - s)) - (syntax->list (syntax exports)))) - (syntax exports))] - [extract-unit (syntax (_unit - (import . exports) - (export) - (values . exports)))]) - (with-syntax ([invoke-unit (with-syntax ([(x . imports) - (if prefix - (syntax prefix+imports) - `(#f))]) - (syntax (invoke-unit - (compound-unit - (import . imports) - (link [unit-to-invoke (unite . imports)] - [export-extractor - (extract-unit (unit-to-invoke . exports))]) - (export)) - . imports)))]) - (if global? - (syntax (let-values ([(tagged-export ...) invoke-unit]) - (namespace-set-variable-value! 'tagged-export tagged-export) - ... - (void))) - (syntax (define-values (tagged-export ...) invoke-unit)))))))])))]) - (values (mk #f) (mk #t)))) - (provide (rename _unit unit) unit/no-expand - compound-unit invoke-unit unit? - (struct exn:fail:unit ()) + ;; build-val+macro-defs : sig -> (list syntax-object^3) + (define-for-syntax (build-val+macro-defs sig) + (with-syntax ([(((int-ivar . ext-ivar) ...) + ((((int-vid . ext-vid) ...) . vbody) ...) + ((((int-sid . ext-sid) ...) . sbody) ...)) + (map-sig (lambda (x) x) + (make-syntax-introducer) + sig) + #;(add-context-to-sig sig)]) + (list + #'((ext-ivar ... ext-vid ... ... ext-sid ... ...) + (values + (make-rename-transformer + (quote-syntax int-ivar)) ... + (make-rename-transformer + (quote-syntax int-vid)) ... ... + (make-rename-transformer + (quote-syntax int-sid)) ... ...)) + #'(((int-sid ...) sbody) ...) + #'(((int-vid ...) vbody) ...)))) + + + (define-signature-form (open stx) + (parameterize ([error-syntax stx]) + (syntax-case stx () + ((_ export-spec) + (let ([sig (process-spec #'export-spec)]) + (with-syntax ((((int . ext) ...) (car sig)) + ((renames + (((mac-name ...) mac-body) ...) + (((val-name ...) val-body) ...)) + (build-val+macro-defs sig))) + (syntax->list + #'(int ... + (define-syntaxes . renames) + (define-syntaxes (mac-name ...) mac-body) ... + (define-values (val-name ...) val-body) ...))))) + (_ + (raise-stx-err (format "must match (~a export-spec)" + (syntax-e (stx-car stx)))))))) + + + (define-for-syntax (introduce-def d) + (cons (map syntax-local-introduce (car d)) + (syntax-local-introduce (cdr d)))) + + ;; build-define-syntax : identifier (or/c identifier #f) syntax-object -> syntax-object + (define-for-syntax (build-define-signature sigid super-sigid sig-exprs) + (unless (or (stx-null? sig-exprs) (stx-pair? sig-exprs)) + (raise-stx-err "expected syntax matching (sig-expr ...)" sig-exprs)) + (let ([ses (checked-syntax->list sig-exprs)]) + (define-values (super-names super-ctimes super-rtimes super-bindings + super-val-defs super-stx-defs) + (if super-sigid + (let* ([super-sig (lookup-signature super-sigid)] + [super-siginfo (signature-siginfo super-sig)]) + (values (siginfo-names super-siginfo) + (siginfo-ctime-ids super-siginfo) + (map syntax-local-introduce + (siginfo-rtime-ids super-siginfo)) + (map syntax-local-introduce (signature-vars super-sig)) + (map introduce-def (signature-val-defs super-sig)) + (map introduce-def (signature-stx-defs super-sig)))) + (values '() '() '() '() '() '()))) + (let loop ((sig-exprs ses) + (bindings null) + (val-defs null) + (stx-defs null)) + (cond + ((null? sig-exprs) + (let* ([all-bindings (append super-bindings (reverse bindings))] + [all-val-defs (append super-val-defs (reverse val-defs))] + [all-stx-defs (append super-stx-defs (reverse stx-defs))] + [dup + (check-duplicate-identifier + (append all-bindings + (apply append (map car all-val-defs)) + (apply append (map car all-stx-defs))))]) + (when dup + (raise-stx-err "duplicate identifier" dup)) + (with-syntax (((super-rtime ...) super-rtimes) + ((super-name ...) super-names) + ((var ...) all-bindings) + ((((vid ...) . vbody) ...) all-val-defs) + ((((sid ...) . sbody) ...) all-stx-defs)) + #`(begin + (define x (gensym)) + (define-syntax #,sigid + (make-set!-transformer + (make-signature + (make-siginfo (list #'#,sigid #'super-name ...) + (list ((syntax-local-certifier) (quote-syntax x)) + #'super-rtime + ...)) + (list (quote-syntax var) ...) + (list (cons (list (quote-syntax vid) ...) + ((syntax-local-certifier) + (quote-syntax vbody))) + ...) + (list (cons (list (quote-syntax sid) ...) + ((syntax-local-certifier) + (quote-syntax sbody))) + ...)))))))) + (else + (syntax-case (car sig-exprs) (define-values define-syntaxes) + (x + (identifier? #'x) + (loop (cdr sig-exprs) (cons #'x bindings) val-defs stx-defs)) + ((x . y) + (and (identifier? #'x) + (or (module-identifier=? #'x #'define-values) + (module-identifier=? #'x #'define-syntaxes))) + (begin + (check-def-syntax (car sig-exprs)) + (syntax-case #'y () + (((name ...) body) + (begin + (for-each (lambda (id) (check-id id)) + (syntax->list #'(name ...))) + (let ((b #'body)) + (loop (cdr sig-exprs) + bindings + (if (module-identifier=? #'x #'define-values) + (cons (cons (syntax->list #'(name ...)) b) + val-defs) + val-defs) + (if (module-identifier=? #'x #'define-syntaxes) + (cons (cons (syntax->list #'(name ...)) b) + stx-defs) + stx-defs)))))))) + ((x . y) + (let ((trans + (set!-trans-extract + (syntax-local-value + (syntax-local-introduce #'x) + (lambda () + (raise-stx-err "unknown signature form" #'x)))))) + (unless (signature-form? trans) + (raise-stx-err "not a signature form" #'x)) + (let ((results ((signature-form-f trans) (car sig-exprs)))) + (unless (list? results) + (raise-stx-err + (format "expected list of results from signature form, got ~e" results) + (car sig-exprs))) + (loop (append results (cdr sig-exprs)) + bindings + val-defs + stx-defs)))) + (x (raise-stx-err + "expected either an identifier or signature form" + #'x)))))))) - define-values/invoke-unit - namespace-variable-bind/invoke-unit)) + + (define-syntax/err-param (define-signature stx) + (syntax-case stx (extends) + ((_ sig-name sig-exprs) + (begin + (check-id #'sig-name) + (build-define-signature #'sig-name #f #'sig-exprs))) + ((_ sig-name extends super-name sig-exprs) + (begin + (check-id #'sig-name) + (check-id #'super-name) + (build-define-signature #'sig-name #'super-name #'sig-exprs))) + (_ + (begin + (checked-syntax->list stx) + (raise-stx-err + (format "expected syntax matching (~a identifier (sig-expr ...)) or (~a identifier extends identifier (sig-expr ...))" + (syntax-e (stx-car stx)) (syntax-e (stx-car stx)))))))) + + (define-for-syntax (signature->identifiers sigids) + (define provide-tagged-sigs (map process-tagged-import sigids)) + (define provide-sigs (map caddr provide-tagged-sigs)) + (apply append (map sig-int-names provide-sigs))) + + (define-syntax/err-param (provide-signature-elements stx) + (syntax-case stx () + ((_ . p) + (let* ((names (signature->identifiers (checked-syntax->list #'p))) + (dup (check-duplicate-identifier names))) + (when dup + (raise-stx-err (format "duplicate binding for ~e" (syntax-e dup)))) + (quasisyntax/loc stx + (provide #,@names)))))) + + ;; A unit is + ;; - (unit (import import-spec ...) (export export-spec ...) unit-body-expr ...) + + (define-for-syntax (localify exp def-ctx) + (cadr (syntax->list + (local-expand #`(stop #,exp) + 'expression + (list #'stop) + def-ctx)))) + + (define-for-syntax (add-context-to-sig sig) + (let ((def-ctx (syntax-local-make-definition-context))) + (syntax-local-bind-syntaxes (sig-ext-names sig) #f def-ctx) + (map-sig (lambda (x) x) + (lambda (x) (localify x def-ctx)) + sig))) + + (define-for-syntax (iota n) + (let loop ((n n) + (acc null)) + (cond + ((= n 0) acc) + (else (loop (sub1 n) (cons (sub1 n) acc)))))) + + + (define-syntax (unit-export stx) + (syntax-case stx () + ((_ ((esig ...) elocs) ...) + (with-syntax ((((kv ...) ...) + (map + (lambda (esigs eloc) + (map + (lambda (esig) #`(#,esig #,eloc)) + (syntax->list esigs))) + (syntax->list #'((esig ...) ...)) + (syntax->list #'(elocs ...))))) + #'(hash-table 'equal kv ... ...))))) + + ;; build-key : (or symbol #f) identifier -> syntax-object + (define-for-syntax (build-key tag i) + (if tag + #`(cons '#,tag #,i) + i)) + + ;; tagged-info->keys : (cons (or symbol #f) siginfo) -> (listof syntax-object) + (define-for-syntax (tagged-info->keys tagged-info) + (define tag (car tagged-info)) + (map (lambda (rid) + (build-key tag (syntax-local-introduce rid))) + (siginfo-rtime-ids (cdr tagged-info)))) + + ;; check-duplicate-sigs : (listof (cons symbol siginfo)) (listof syntax-object) + ;; (listof (cons symbol siginfo)) (listof syntax-object) -> + (define-for-syntax (check-duplicate-sigs tagged-siginfos sources tagged-deps dsources) + (define import-idx (make-hash-table 'equal)) + (for-each + (lambda (tinfo s) + (define key (cons (car tinfo) + (car (siginfo-ctime-ids (cdr tinfo))))) + (when (hash-table-get import-idx key (lambda () #f)) + (raise-stx-err "duplicate import signature" s)) + (hash-table-put! import-idx key #t)) + tagged-siginfos + sources) + (for-each + (lambda (dep s) + (unless (hash-table-get import-idx + (cons (car dep) + (car (siginfo-ctime-ids (cdr dep)))) + (lambda () #f)) + (raise-stx-err "initialization dependency on unknown import" s))) + tagged-deps + dsources)) + + (define-for-syntax (tagged-sigid->tagged-siginfo x) + (cons (car x) + (signature-siginfo (lookup-signature (cdr x))))) + + (define-for-syntax (check-unit-ie-sigs import-sigs export-sigs) + (let ([dup (check-duplicate-identifier + (apply append (map sig-int-names import-sigs)))]) + (when dup + (raise-stx-err + (format "~a is imported by multiple signatures" (syntax-e dup))))) + + (let ([dup (check-duplicate-identifier + (apply append (map sig-int-names export-sigs)))]) + (when dup + (raise-stx-err (format "~a is exported by multiple signatures" + (syntax-e dup))))) + + (let ([dup (check-duplicate-identifier + (append + (apply append (map sig-int-names import-sigs)) + (apply append (map sig-int-names export-sigs))))]) + (when dup + (raise-stx-err (format "import ~a is exported" (syntax-e dup)))))) + + + (define-for-syntax (process-unit-import/export process) + (lambda (s) + (define x1 (syntax->list s)) + (define x2 (map process x1)) + (values x1 x2 (map car x2) (map cadr x2) (map caddr x2)))) + + (define-for-syntax process-unit-import + (process-unit-import/export process-tagged-import)) + + (define-for-syntax process-unit-export + (process-unit-import/export process-tagged-export)) + + ;; build-unit : syntax-object -> + ;; (values syntax-object (listof identifier) (listof identifier)) + ;; constructs the code for a unit expression. stx must be + ;; such that it passes check-unit-syntax. + ;; The two additional values are the identifiers of the unit's import and export + ;; signatures + (define-for-syntax (build-unit stx) + (syntax-case stx (import export init-depend) + (((import i ...) + (export e ...) + (init-depend id ...) + . body) + + (let* ([d (syntax->list #'(id ...))] + [dep-tagged-sigids (map check-tagged-id d)] + [dep-tagged-siginfos + (map tagged-sigid->tagged-siginfo dep-tagged-sigids)]) + + (define-values (isig tagged-import-sigs import-tagged-infos + import-tagged-sigids import-sigs) + (process-unit-import #'(i ...))) + + (define-values (esig tagged-export-sigs export-tagged-infos + export-tagged-sigids export-sigs) + (process-unit-export #'(e ...))) + + (check-duplicate-sigs import-tagged-infos isig dep-tagged-siginfos d) + + (check-duplicate-subs export-tagged-infos esig) + + (check-unit-ie-sigs import-sigs export-sigs) + + (with-syntax ((((dept . depr) ...) + (map + (lambda (tinfo) + (cons (car tinfo) + (syntax-local-introduce (car (siginfo-rtime-ids (cdr tinfo)))))) + dep-tagged-siginfos)) + [((renames (mac ...) (val ...)) ...) + (map build-val+macro-defs import-sigs)] + [(((int-ivar . ext-ivar) ...) ...) (map car import-sigs)] + [(((int-evar . ext-evar) ...) ...) (map car export-sigs)] + [((iloc ...) ...) + (map (lambda (x) (generate-temporaries (car x))) import-sigs)] + [((eloc ...) ...) + (map (lambda (x) (generate-temporaries (car x))) export-sigs)] + [((import-key import-super-keys ...) ...) + (map tagged-info->keys import-tagged-infos)] + [((export-key ...) ...) + (map tagged-info->keys export-tagged-infos)] + [(import-name ...) + (map (lambda (tag/info) (car (siginfo-names (cdr tag/info)))) + import-tagged-infos)] + [(export-name ...) + (map (lambda (tag/info) (car (siginfo-names (cdr tag/info)))) + export-tagged-infos)] + [name (syntax-local-infer-name (error-syntax))] + [(icount ...) (map + (lambda (import) (length (car import))) + import-sigs)]) + + (values + (quasisyntax/loc (error-syntax) + (make-unit + 'name + (vector-immutable (cons-immutable 'import-name + (vector-immutable import-key import-super-keys ...)) ...) + (vector-immutable (cons-immutable 'export-name + (vector-immutable export-key ...)) ...) + (list-immutable (cons-immutable 'dept depr) ...) + (lambda () + (let ([eloc (box undefined)] ... ...) + (values + (lambda (import-table) + (let-values ([(iloc ...) + (vector->values (hash-table-get import-table import-key) 0 icount)] + ...) + (letrec-syntaxes ([(int-ivar ...) + (make-id-mappers + (quote-syntax (unbox iloc)) + ...)] + ... + [(int-evar ...) + (make-id-mappers + (quote-syntax (unbox eloc)) + ...)] + ...) + (letrec-syntaxes+values (renames ... + mac ... ...) + (val ... ...) + (unit-body #,(error-syntax) + (int-ivar ... ...) + (int-evar ... ...) + (eloc ... ...) + . body))))) + (unit-export ((export-key ...) (vector-immutable eloc ...)) ...)))))) + import-tagged-sigids + export-tagged-sigids + dep-tagged-sigids)))))) + + (define-syntax/err-param (:unit stx) + (syntax-case stx () + ((_ . x) + (begin + (let-values (((u x y z) (build-unit (check-unit-syntax #'x)))) + u))))) + + (define-syntax (unit-body stx) + (syntax-case stx () + ((_ err-stx (ivar ...) (evar ...) (eloc ...) body ...) + (parameterize ((error-syntax #'err-stx)) + (let* ([expand-context (generate-expand-context)] + [def-ctx (syntax-local-make-definition-context)] + [localify (lambda (ids) + (cdr (syntax->list + (local-expand #`(stop #,@ids) + 'expression + (list #'stop) + def-ctx))))] + [local-ivars (localify (syntax->list #'(ivar ...)))] + [local-evars (localify (syntax->list #'(evar ...)))] + [definition? + (lambda (id) + (and (identifier? id) + (or (module-identifier=? id (quote-syntax define-values)) + (module-identifier=? id (quote-syntax define-syntaxes)))))] + [expanded-body + (let expand-all ((defns&exprs (syntax->list #'(body ...)))) + ;; Also lifted from Matthew, to expand the body enough + (apply + append + (map + (lambda (defn-or-expr) + (let ([defn-or-expr + (local-expand + defn-or-expr + expand-context + (append + (kernel-form-identifier-list (quote-syntax here)) + (syntax->list #'(ivar ... evar ...))) + def-ctx)]) + (syntax-case defn-or-expr (begin define-values define-syntaxes) + [(begin . l) + (let ([l (parameterize ((error-syntax defn-or-expr)) + (checked-syntax->list #'l))]) + (expand-all (map (lambda (s) + (syntax-track-origin s defn-or-expr #'begin)) + l)))] + [(define-syntaxes (id ...) rhs) + (andmap identifier? (syntax->list #'(id ...))) + (with-syntax ([rhs (local-transformer-expand + #'rhs + 'expression + null)]) + (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #'rhs def-ctx) + (list #'(define-syntaxes (id ...) rhs)))] + [(define-values (id ...) rhs) + (andmap identifier? (syntax->list #'(id ...))) + (begin + (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #f def-ctx) + (list defn-or-expr))] + [else (list defn-or-expr)]))) + defns&exprs)))] + ;; Get all the defined names, sorting out variable definitions + ;; from syntax definitions. + [defined-names-table + (let ((table (make-bound-identifier-mapping))) + (for-each + (lambda (defn-or-expr) + (syntax-case defn-or-expr () + ((dv . rest) + (definition? #'dv) + (begin + (check-def-syntax defn-or-expr) + (syntax-case #'rest () + [((id ...) expr) + (for-each + (lambda (id) + (when (bound-identifier-mapping-get table id (lambda () #f)) + (raise-stx-err "variable defined twice" id)) + (bound-identifier-mapping-put! + table id + (make-var-info (module-identifier=? #'dv (quote-syntax define-syntaxes)) + #f + id))) + (syntax->list #'(id ...)))] + [_ (void)]))) + [_ (void)])) + expanded-body) + table)]) + + ;; Mark exported names and + ;; check that all exported names are defined (as var): + (for-each + (lambda (name loc) + (let ([v (bound-identifier-mapping-get defined-names-table + name + (lambda () #f))]) + (unless v + (raise-stx-err (format "undefined export ~a" (syntax-e name)))) + (when (var-info-syntax? v) + (raise-stx-err "cannot export syntax from a unit" name)) + (set-var-info-exported?! v loc))) + local-evars + (syntax->list #'(eloc ...))) + + ;; Check that none of the imports are defined + (for-each + (lambda (i) + (let ((defid (bound-identifier-mapping-get defined-names-table + i + (lambda () #f)))) + (when defid + (raise-stx-err + "definition for imported identifier" + (var-info-id defid))))) + local-ivars) + + (with-syntax ([(intname ...) + (foldr + (lambda (var res) + (cond + ((not (or (var-info-syntax? (cdr var)) + (var-info-exported? (cdr var)))) + (cons (car var) res)) + (else res))) + null + (bound-identifier-mapping-map defined-names-table cons))] + [(l-evar ...) local-evars] + [(defn&expr ...) + (filter + values + (map (lambda (defn-or-expr) + (syntax-case defn-or-expr (define-values define-syntaxes) + [(define-values () expr) + (syntax/loc defn-or-expr (set!-values () expr))] + [(define-values ids expr) + (let ([ids (syntax->list #'ids)] + [do-one + (lambda (id tmp name) + (let ([export-loc + (var-info-exported? + (bound-identifier-mapping-get + defined-names-table + id))]) + (cond + (export-loc + ;; set! exported id: + (quasisyntax/loc defn-or-expr + (set-box! #,export-loc + #,(if name + #`(let ([#,name #,tmp]) + #,name) + tmp)))) + (else + ;; not an exported id + (quasisyntax/loc defn-or-expr + (set! #,id #,tmp))))))]) + (if (null? (cdr ids)) + (do-one (car ids) (syntax expr) (car ids)) + (let ([tmps (generate-temporaries ids)]) + (with-syntax ([(tmp ...) tmps] + [(set ...) + (map (lambda (id tmp) + (do-one id tmp #f)) + ids tmps)]) + (syntax/loc defn-or-expr + (let-values ([(tmp ...) expr]) + set ...))))))] + [(define-syntaxes . l) #f] + [else defn-or-expr])) + expanded-body))] + [(stx-defn ...) + (filter + values + (map (lambda (defn-or-expr) + (syntax-case defn-or-expr (define-syntaxes) + [(define-syntaxes . l) #'l] + [else #f])) + expanded-body))]) + #'(letrec-syntaxes+values (stx-defn + ... + ((l-evar) (make-rename-transformer (quote-syntax evar))) + ...) + ([(intname) undefined] ...) + (void) ; in case the body would be empty + defn&expr ...))))))) + + (define-for-syntax (redirect-imports/exports import?) + (lambda (table-stx + import-tagged-infos + import-sigs + target-import-tagged-infos + target-import-sigs) + (define def-table (make-bound-identifier-mapping)) + (for-each + (lambda (tagged-info sig) + (define v + #`(hash-table-get #,table-stx #,(car (tagged-info->keys tagged-info)))) + (for-each + (lambda (int/ext-name index) + (bound-identifier-mapping-put! def-table + (car int/ext-name) + #`(vector-ref #,v #,index))) + (car sig) + (iota (length (car sig))))) + import-tagged-infos + import-sigs) + (with-syntax ((((eloc ...) ...) + (map + (lambda (target-sig) + (map + (lambda (target-int/ext-name) + (bound-identifier-mapping-get + def-table + (car target-int/ext-name) + (lambda () + (raise-stx-err + (format (if import? + "identifier ~a is not present in new imports" + "identifier ~a is not present in old export") + (syntax-e (car target-int/ext-name))))))) + (car target-sig))) + target-import-sigs)) + (((export-keys ...) ...) + (map tagged-info->keys target-import-tagged-infos))) + #`(unit-export ((export-keys ...) + (vector-immutable eloc ...)) ...)))) + + (define-for-syntax redirect-imports (redirect-imports/exports #t)) + (define-for-syntax redirect-exports (redirect-imports/exports #f)) + + + ;; build-unit/new-import-export : syntax-object -> + ;; (values syntax-object (listof identifier) (listof identifier)) + ;; constructs the code for a unit expression that changes the import and export signatures + ;; of another. stx must be such that it passes check-unit-syntax. + ;; The two additional values are the identifiers of the unit's import and export + ;; signatures + (define-for-syntax (build-unit/new-import-export stx) + (syntax-case stx (import export init-depend) + (((import i ...) + (export e ...) + (init-depend id ...) + . body) + + (let* ([d (syntax->list #'(id ...))] + [dep-tagged-sigids (map check-tagged-id d)] + [dep-tagged-siginfos + (map tagged-sigid->tagged-siginfo dep-tagged-sigids)]) + (define-values (isig tagged-import-sigs import-tagged-infos + import-tagged-sigids import-sigs) + (process-unit-import #'(i ...))) + + (define-values (esig tagged-export-sigs export-tagged-infos + export-tagged-sigids export-sigs) + (process-unit-export #'(e ...))) + + (check-duplicate-sigs import-tagged-infos isig dep-tagged-siginfos d) + + (check-duplicate-subs export-tagged-infos esig) + + (check-unit-ie-sigs import-sigs export-sigs) + + (syntax-case #'body () + ((b) (check-link-line-syntax #'b)) + (() (raise-stx-err "missing unit specification")) + (_ (raise-stx-err "expects a single unit specification"))) + + (with-syntax (((((orig-e ...) unit-exp orig-i ...)) #'body)) + (define-values (orig-isig orig-tagged-import-sigs orig-import-tagged-infos + orig-import-tagged-sigids orig-import-sigs) + (process-unit-export #'(orig-i ...))) + + (define-values (orig-esig orig-tagged-export-sigs orig-export-tagged-infos + orig-export-tagged-sigids orig-export-sigs) + (process-unit-import #'(orig-e ...))) + (with-syntax ((((dept . depr) ...) + (map + (lambda (tinfo) + (cons (car tinfo) + (syntax-local-introduce (car (siginfo-rtime-ids (cdr tinfo)))))) + dep-tagged-siginfos)) + [((import-key ...) ...) + (map tagged-info->keys import-tagged-infos)] + [((export-key ...) ...) + (map tagged-info->keys export-tagged-infos)] + [((orig-import-key ...) ...) + (map tagged-info->keys orig-import-tagged-infos)] + [((orig-export-key ...) ...) + (map tagged-info->keys orig-export-tagged-infos)] + [(import-name ...) + (map (lambda (tag/info) (car (siginfo-names (cdr tag/info)))) + import-tagged-infos)] + [(export-name ...) + (map (lambda (tag/info) (car (siginfo-names (cdr tag/info)))) + export-tagged-infos)] + [(orig-import-name ...) + (map (lambda (tag/info) (car (siginfo-names (cdr tag/info)))) + orig-import-tagged-infos)] + [(orig-export-name ...) + (map (lambda (tag/info) (car (siginfo-names (cdr tag/info)))) + orig-export-tagged-infos)] + [name (syntax-local-infer-name (error-syntax))] + [form (syntax-e (stx-car (error-syntax)))]) + (values + (quasisyntax/loc (error-syntax) + (let ([unit-tmp unit-exp]) + (check-unit unit-tmp 'form) + (check-sigs unit-tmp + (vector-immutable + (cons-immutable 'orig-import-name + (vector-immutable orig-import-key ...)) ...) + (vector-immutable + (cons-immutable 'orig-export-name + (vector-immutable orig-export-key ...)) ...) + 'form) + (make-unit + 'name + (vector-immutable (cons-immutable 'import-name + (vector-immutable import-key ...)) ...) + (vector-immutable (cons-immutable 'export-name + (vector-immutable export-key ...)) ...) + (list-immutable (cons-immutable 'dept depr) ...) + (lambda () + (let-values ([(unit-fn export-table) ((unit-go unit-tmp))]) + (values (lambda (import-table) + (unit-fn #,(redirect-imports #'import-table + import-tagged-infos + import-sigs + orig-import-tagged-infos + orig-import-sigs))) + #,(redirect-exports #'export-table + orig-export-tagged-infos + orig-export-sigs + export-tagged-infos + export-sigs))))))) + import-tagged-sigids + export-tagged-sigids + dep-tagged-sigids))))))) + + + (define-syntax/err-param (unit/new-import-export stx) + (syntax-case stx () + ((_ . x) + (begin + (let-values (((u x y z) (build-unit/new-import-export (check-unit-syntax #'x)))) + u))))) + + ;; build-compound-unit : syntax-object -> + ;; (values syntax-object (listof identifier) (listof identifier)) + ;; constructs the code for a compound-unit expression. stx match the return of + ;; check-compound-syntax + ;; The two additional values are the identifiers of the compound-unit's import and export + ;; signatures + (define-for-syntax (build-compound-unit stx) + (define-struct lnkid-record (access-code names ctime-ids rtime-ids source-idx sigid siginfo)) + (define (lnkid-rec->keys t rec) + (map (lambda (rid) (build-key t rid)) + (lnkid-record-rtime-ids rec))) + (syntax-case stx () + (((import ...) + (export-lnktag ...) + (((sub-out ...) sub-exp sub-in-lnktag ...) ...)) + (with-syntax ((((import-tag import-lnkid . import-sigid) ...) + (map check-tagged-:-clause (syntax->list #'(import ...)))) + (((export-tag . export-lnkid) ...) + (map check-tagged-id + (syntax->list #'(export-lnktag ...)))) + ((((sub-out-tag sub-out-lnkid . sub-out-sigid) ...) ...) + (map (lambda (e) (map check-tagged-:-clause (syntax->list e))) + (syntax->list #'((sub-out ...) ...)))) + ((((sub-in-tag . sub-in-lnkid) ...) ...) + (map (lambda (t) (map check-tagged-id (syntax->list t))) + (syntax->list #'((sub-in-lnktag ...) ...))))) + + (let ([dup (check-duplicate-identifier + (syntax->list #'(import-lnkid ... sub-out-lnkid ... ...)))]) + (when dup + (raise-stx-err "duplicate linking identifier definition" dup))) + + + (let ([bt (make-bound-identifier-mapping)]) + (for-each + (lambda (lnkid) + (bound-identifier-mapping-put! bt lnkid #t)) + (syntax->list #'(import-lnkid ...))) + (for-each + (lambda (lnkid) + (when (bound-identifier-mapping-get bt lnkid (lambda () #f)) + (raise-stx-err "cannot directly export an import" lnkid))) + (syntax->list #'(export-lnkid ...)))) + + + (let* ([idxs (iota (add1 (length (syntax->list #'(sub-exp ...)))))] + [sub-export-table-tmps (generate-temporaries #'(sub-exp ...))] + [link-map + (let ((bt (make-bound-identifier-mapping))) + (for-each + (lambda (tags lnkids sigids tableid i) + (for-each + (lambda (tag lnkid sigid) + (define siginfo (signature-siginfo (lookup-signature sigid))) + (define rtime-ids (map syntax-local-introduce + (siginfo-rtime-ids siginfo))) + (bound-identifier-mapping-put! + bt + lnkid + (make-lnkid-record + #`(hash-table-get + #,tableid + #,(build-key (syntax-e tag) (car rtime-ids))) + (siginfo-names siginfo) + (siginfo-ctime-ids siginfo) + rtime-ids + i + sigid + siginfo))) + (syntax->list tags) + (syntax->list lnkids) + (syntax->list sigids))) + (syntax->list #'((import-tag ...) (sub-out-tag ...) ...)) + (syntax->list #'((import-lnkid ...) (sub-out-lnkid ...) ...)) + (syntax->list #'((import-sigid ...) (sub-out-sigid ...) ...)) + (cons #'import-table-id sub-export-table-tmps) + idxs) + (lambda (id) + (bound-identifier-mapping-get + bt + id + (lambda () + (raise-stx-err "unknown linking identifier" id)))))] + [link-deps + (map + (lambda (tags lnkids i) + (define ht (make-hash-table 'equal)) + (for-each + (lambda (t l) + (define et (syntax-e t)) + (define el (syntax-e l)) + (define rec (link-map l)) + (define forward-dep (>= (lnkid-record-source-idx rec) i)) + (define import-dep (= 0 (lnkid-record-source-idx rec))) + (for-each + (lambda (ctime-id rtime-id name) + (hash-table-put! ht + (build-key et ctime-id) + (list forward-dep import-dep et rtime-id name el))) + (lnkid-record-ctime-ids rec) + (lnkid-record-rtime-ids rec) + (lnkid-record-names rec))) + (syntax->list tags) + (syntax->list lnkids)) + (hash-table-map ht (lambda (x y) y))) + (syntax->list #'((sub-in-tag ...) ...)) + (syntax->list #'((sub-in-lnkid ...) ...)) + (cdr idxs))]) + + (check-duplicate-subs + (map (lambda (t lid) (cons (syntax-e t) + (lnkid-record-siginfo (link-map lid)))) + (syntax->list #'(export-tag ...)) + (syntax->list #'(export-lnkid ...))) + (syntax->list #'(export-lnktag ...))) + + (with-syntax (((sub-tmp ...) (generate-temporaries #'(sub-exp ...))) + ((sub-export-table-tmp ...) sub-export-table-tmps) + (name (syntax-local-infer-name (error-syntax))) + (((import-key ...) ...) + (map + (lambda (t l) + (lnkid-rec->keys (syntax-e t) (link-map l))) + (syntax->list #'(import-tag ...)) + (syntax->list #'(import-lnkid ...)))) + (((export-key ...) ...) + (map + (lambda (t l) + (lnkid-rec->keys (syntax-e t) (link-map l))) + (syntax->list #'(export-tag ...)) + (syntax->list #'(export-lnkid ...)))) + ((import-name ...) + (map (lambda (l) (car (lnkid-record-names (link-map l)))) + (syntax->list #'(import-lnkid ...)))) + ((export-name ...) + (map (lambda (l) (car (lnkid-record-names (link-map l)))) + (syntax->list #'(export-lnkid ...)))) + (((((sub-in-key sub-in-code) ...) ...) ...) + (map + (lambda (stxed-tags lnkids) + (define lnkid-recs (map link-map (syntax->list lnkids))) + (define tags (map syntax-e (syntax->list stxed-tags))) + (define tagged-siginfos + (map + (lambda (t l) (cons t (lnkid-record-siginfo l))) + tags + lnkid-recs)) + (check-duplicate-subs tagged-siginfos (syntax->list lnkids)) + (map + (lambda (t lr) + (with-syntax (((key ...) + (lnkid-rec->keys t lr))) + #`((key #,(lnkid-record-access-code lr)) ...))) + tags + lnkid-recs)) + (syntax->list #'((sub-in-tag ...) ...)) + (syntax->list #'((sub-in-lnkid ...) ...)))) + ((((sub-out-key ...) ...) ...) + (map + (lambda (lnkids tags) + (map + (lambda (l t) + (lnkid-rec->keys (syntax-e t) (link-map l))) + (syntax->list lnkids) + (syntax->list tags))) + (syntax->list #'((sub-out-lnkid ...) ...)) + (syntax->list #'((sub-out-tag ...) ...)))) + (((export-sigid . export-code) ...) + (map (lambda (lnkid) + (define s (link-map lnkid)) + (cons (lnkid-record-sigid s) + (lnkid-record-access-code s))) + (syntax->list #'(export-lnkid ...)))) + (form (syntax-e (stx-car (error-syntax)))) + ) + + (with-syntax (((check-sub-exp ...) + (map + (lambda (stx link-deps) + (with-syntax (((sub-exp + sub-tmp + ((sub-in-key ...) ...) + ((sub-out-key ...) ...) + sub-in-lnkid + sub-out-lnkid) + stx)) + (with-syntax (((sub-in-signame ...) + (map (lambda (l) (car (lnkid-record-names (link-map l)))) + (syntax->list #'sub-in-lnkid))) + ((sub-out-signame ...) + (map (lambda (l) (car (lnkid-record-names (link-map l)))) + (syntax->list #'sub-out-lnkid))) + (((fdep-tag fdep-rtime fsig-name flnk-name) ...) + (map cddr (filter car link-deps))) + (((rdep-tag rdep-rtime . _) ...) + (map cddr (filter cadr link-deps)))) + #`(begin + #,(syntax/loc #'sub-exp + (check-unit sub-tmp 'form)) + #,(syntax/loc #'sub-exp + (check-sigs sub-tmp + (vector-immutable + (cons-immutable 'sub-in-signame + (vector-immutable sub-in-key ...)) + ...) + (vector-immutable + (cons-immutable 'sub-out-signame + (vector-immutable sub-out-key ...)) + ...) + 'form)) + (let ([fht (hash-table 'equal + ((cons-immutable 'fdep-tag fdep-rtime) + (cons-immutable 'fsig-name 'flnk-name)) + ...)] + [rht (hash-table 'equal + ((cons-immutable 'rdep-tag rdep-rtime) + #t) + ...)]) + #,(syntax/loc #'sub-exp (check-deps fht sub-tmp 'form)) + (for-each + (lambda (dep) + (when (hash-table-get rht dep (lambda () #f)) + (set! deps (cons dep deps)))) + (unit-deps sub-tmp))))))) + (syntax->list #'((sub-exp + sub-tmp + ((sub-in-key ...) ...) + ((sub-out-key ...) ...) + (sub-in-lnkid ...) + (sub-out-lnkid ...)) + ...)) + link-deps)) + (((sub-in-key-code-workaround ...) ...) + (map + (lambda (x) + (with-syntax ((((a ...) ...) x)) + #'(a ... ...))) + (syntax->list #'((((sub-in-key sub-in-code) ...) ...) ...)))) + ) + (values + (quasisyntax/loc (error-syntax) + (let ([deps '()] + [sub-tmp sub-exp] ...) + check-sub-exp ... + (make-unit + 'name + (vector-immutable + (cons-immutable 'import-name + (vector-immutable import-key ...)) + ...) + (vector-immutable + (cons-immutable 'export-name + (vector-immutable export-key ...)) + ...) + deps + (lambda () + (let-values ([(sub-tmp sub-export-table-tmp) ((unit-go sub-tmp))] + ...) + (values (lambda (import-table-id) + (void) + (sub-tmp (hash-table 'equal sub-in-key-code-workaround ...)) + ...) + (unit-export ((export-key ...) export-code) ...))))))) + (map syntax-e (syntax->list #'((import-tag . import-sigid) ...))) + (map syntax-e (syntax->list #'((export-tag . export-sigid) ...))) + '())))))) + (((i ...) (e ...) (l ...)) + (for-each check-link-line-syntax (syntax->list #'(l ...)))))) + + + (define-syntax/err-param (compound-unit stx) + (let-values (((u x y z) + (build-compound-unit + (check-compound-syntax (syntax-case stx () ((_ . x) #'x)))))) + u)) + + + (define (invoke-unit/core unit) + (check-unit unit 'invoke-unit) + (check-no-imports unit 'invoke-unit) + (let-values ([(f exports) ((unit-go unit))]) + (f #f))) + + (define-syntax/err-param (define-values/invoke-unit/core stx) + (syntax-case stx () + ((_ unit-expr . unit-out) + (let* ((unit-out (checked-syntax->list #'unit-out)) + (tagged-out (map process-tagged-import unit-out)) + (out-tags (map car tagged-out)) + (out-sigs (map caddr tagged-out)) + (dup (check-duplicate-identifier (apply append (map sig-int-names out-sigs)))) + (out-vec (generate-temporaries out-sigs))) + (when dup + (raise-stx-err (format "duplicate binding for ~e" (syntax-e dup)))) + (with-syntax ((((key1 key ...) ...) (map tagged-info->keys out-tags)) + ((((int-binding . ext-binding) ...) ...) (map car out-sigs)) + ((out-vec ...) out-vec) + (((renames + (((mac-name ...) mac-body) ...) + (((val-name ...) val-body) ...)) + ...) + (map build-val+macro-defs out-sigs)) + ((out-names ...) + (map (lambda (info) (car (siginfo-names (cdr info)))) + out-tags)) + (((out-code ...) ...) + (map + (lambda (os ov) + (map + (lambda (i) + #`(vector-ref #,ov #,i)) + (iota (length (car os))))) + out-sigs + out-vec))) + (quasisyntax/loc stx + (begin + (define-values (int-binding ... ...) + #,(syntax/loc #'unit-expr + (let ((unit-tmp unit-expr)) + (check-unit unit-tmp 'define-values/invoke-unit) + (check-sigs unit-tmp + (vector-immutable) + (vector-immutable (cons 'out-names + (vector-immutable key1 key ...)) ...) + 'define-values/invoke-unit) + (let-values (((unit-fn export-table) + ((unit-go unit-tmp)))) + (let ([out-vec (hash-table-get export-table key1)] ...) + (unit-fn #f) + (values (unbox out-code) ... ...)))))) + (define-syntaxes . renames) ... + (define-syntaxes (mac-name ...) mac-body) ... ... + (define-values (val-name ...) val-body) ... ...))))) + ((_) + (raise-stx-err "missing unit expression")))) + + ;; build-unit-from-context : syntax-object -> + ;; (values syntax-object (listof identifier) (listof identifier)) + ;; constructs the code for a unit-from-context expression. stx must be + ;; such that it passes check-ufc-syntax. + ;; The two additional values are the identifiers of the unit's import and export + ;; signatures + (define-for-syntax (build-unit-from-context stx) + (syntax-case stx () + ((export-spec) + (let* ((tagged-export-sig (process-tagged-export #'export-spec)) + (export-sig (caddr tagged-export-sig))) + (with-syntax ((((int-id . ext-id) ...) (car export-sig)) + ((def-name ...) (generate-temporaries (map car (car export-sig))))) + (values + #'(:unit (import) (export (rename export-spec (def-name int-id) ...)) + (define def-name int-id) + ...) + null + (list (cadr tagged-export-sig)) + '())))))) + + (define-for-syntax (check-ufc-syntax stx) + (syntax-case stx () + ((export-spec) (void)) + (() + (raise-stx-err "missing export-spec")) + (_ + (raise-stx-err "nothing is permitted after export-spec")))) + + (define-syntax/err-param (unit-from-context stx) + (syntax-case stx () + ((_ . x) + (begin + (check-ufc-syntax #'x) + (let-values (((u x y z) (build-unit-from-context #'x))) + u))))) + + + + ;; build-define-unit : syntax-object + ;; (syntax-object -> (values syntax-object (listof identifier) (listof identifier)) + ;; string -> + ;; syntax-object + (define-for-syntax (build-define-unit stx build err-msg) + (syntax-case stx () + ((_ name . rest) + (begin + (check-id #'name) + (let-values (((exp i e d) (build #'rest))) + (with-syntax ((((itag . isig) ...) i) + (((etag . esig) ...) e) + (((deptag . depsig) ...) d)) + (quasisyntax/loc (error-syntax) + (begin + (define u #,exp) + (define-syntax name + (make-set!-transformer + (make-unit-info ((syntax-local-certifier) (quote-syntax u)) + (list (cons 'itag (quote-syntax isig)) ...) + (list (cons 'etag (quote-syntax esig)) ...) + (list (cons 'deptag (quote-syntax deptag)) ...)))))))))) + ((_) + (raise-stx-err err-msg)))) + + (define-for-syntax (build-define-unit-binding stx) + + (define (check-helper tagged-info) + (cons (car (siginfo-names (cdr tagged-info))) + (tagged-info->keys tagged-info))) + + (syntax-case stx (import export init-depend) + ((unit-exp (import i ...) (export e ...) (init-depend idep ...)) + (let* ([ti (syntax->list #'(i ...))] + [te (syntax->list #'(e ...))] + [tidep (syntax->list #'(idep ...))] + [tagged-import-sigids (map check-tagged-id ti)] + [tagged-export-sigids (map check-tagged-id te)] + [tagged-dep-sigids (map check-tagged-id tidep)] + [tagged-import-infos (map tagged-sigid->tagged-siginfo tagged-import-sigids)] + [tagged-export-infos (map tagged-sigid->tagged-siginfo tagged-export-sigids)] + [tagged-dep-siginfos (map tagged-sigid->tagged-siginfo tagged-dep-sigids)]) + (check-duplicate-sigs tagged-import-infos ti tagged-dep-siginfos tidep) + (check-duplicate-subs tagged-export-infos te) + (with-syntax ((((import-name . (import-keys ...)) ...) + (map check-helper tagged-import-infos)) + (((export-name . (export-keys ...)) ...) + (map check-helper tagged-export-infos)) + (form (stx-car (error-syntax)))) + (values + #`(let ([unit-tmp unit-exp]) + #,(syntax/loc #'unit-exp + (check-unit unit-tmp 'form)) + #,(syntax/loc #'unit-exp + (check-sigs unit-tmp + (vector-immutable + (cons-immutable 'import-name + (vector-immutable import-keys ...)) + ...) + (vector-immutable + (cons-immutable 'export-name + (vector-immutable export-keys ...)) + ...) + 'form)) + unit-tmp) + tagged-import-sigids + tagged-export-sigids + tagged-dep-sigids)))))) + + (define-syntax/err-param (define-unit-binding stx) + (build-define-unit stx (lambda (unit) + (build-define-unit-binding (check-unit-body-syntax unit))) + "missing unit name, unit expression, import clause, and export clause")) + + (define-syntax/err-param (define-unit stx) + (build-define-unit stx (lambda (unit) + (build-unit (check-unit-syntax unit))) + "missing unit name, import clause, and export clause")) + + (define-syntax/err-param (define-unit/new-import-export stx) + (build-define-unit stx (lambda (unit) + (build-unit/new-import-export (check-unit-syntax unit))) + "missing unit name, import clause, and export clause")) + + (define-syntax/err-param (define-compound-unit stx) + (build-define-unit stx (lambda (clauses) + (build-compound-unit (check-compound-syntax clauses))) + "missing unit name")) + + (define-syntax/err-param (define-unit-from-context stx) + (build-define-unit stx (lambda (sig) + (check-ufc-syntax sig) + (build-unit-from-context sig)) + "missing unit name and signature")) + + (define-for-syntax (unprocess-tagged-id ti) + (if (car ti) + #`(tag #,(car ti) #,(cdr ti)) + (cdr ti))) + + (define-syntax/err-param (define-values/invoke-unit/infer stx) + (syntax-case stx () + ((_ u) + (let ((ui (lookup-def-unit #'u))) + (with-syntax (((sig ...) (map unprocess-tagged-id (unit-info-export-sig-ids ui))) + ((isig ...) (map unprocess-tagged-id (unit-info-import-sig-ids ui)))) + (quasisyntax/loc stx + (define-values/invoke-unit u (import isig ...) (export sig ...)))))) + ((_) + (raise-stx-err "missing unit" stx)) + ((_ . b) + (raise-stx-err + (format "expected syntax matching (~a )" + (syntax-e (stx-car stx))))))) + + (define-for-syntax (temp-id-with-tags id i) + (syntax-case i (tag) + [(tag t sig) + (list id #`(tag t #,id) #'sig)] + [_else + (list id id i)])) + + (define-syntax/err-param (define-values/invoke-unit stx) + (syntax-case stx (import export) + ((_ u (import) (export e ...)) + (quasisyntax/loc stx + (define-values/invoke-unit/core u e ...))) + ((_ u (import i ...) (export e ...)) + (with-syntax (((EU ...) (generate-temporaries #'(e ...))) + (((IU IUl i) ...) (map temp-id-with-tags + (generate-temporaries #'(i ...)) + (syntax->list #'(i ...)))) + ((iu ...) (generate-temporaries #'(i ...))) + ((i-id ...) (map cdadr + (map process-tagged-import + (syntax->list #'(i ...))))) + ((e-id ...) (map cdadr + (map process-tagged-export + (syntax->list #'(e ...)))))) + (quasisyntax/loc stx + (begin + (define-unit-from-context iu i) + ... + (define-compound-unit u2 (import) + (export EU ...) + (link [((IU : i-id)) iu] ... [((EU : e-id) ...) u IUl ...])) + (define-values/invoke-unit/core u2 e ...))))) + ((_) + (raise-stx-err "missing unit" stx)) + ((_ . b) + (raise-stx-err + (format "expected syntax matching (~a (import ...) (export ...))" + (syntax-e (stx-car stx))))))) + + ;; build-compound-unit/infer : syntax-object -> + ;; (values syntax-object (listof identifier) (listof identifier)) + ;; constructs the code for a compound-unit/infer expression. stx match the return of + ;; check-compound-syntax + ;; The two additional values are the identifiers of the compound-unit's import and export + ;; signatures + (define-for-syntax (build-compound-unit/infer stx) + + (define (lookup-tagged tid) + (cons (car tid) (lookup-signature (cdr tid)))) + + (define (process-signature s) + (define l + ((check-tagged + (lambda (b) + (syntax-case* b (:) (lambda (x y) (eq? (syntax-e x) (syntax-e y))) + ((x : y) + (and (identifier? #'x) (identifier? #'y)) + (list #'x #'y (signature-siginfo (lookup-signature #'y)))) + (x + (identifier? #'x) + (list (car (generate-temporaries (list #'x))) + #'x + (signature-siginfo (lookup-signature #'x)))) + (_ + (raise-stx-err "expected syntax matching or ( : )" + b))))) + s)) + (apply make-link-record l)) + + (define (process-tagged-sigid sid) + (make-link-record (car sid) #f (cdr sid) (signature-siginfo (lookup-signature (cdr sid))))) + + (syntax-case stx () + (((import ...) + (export ...) + (((out ...) u l ...) ...)) + (let* ([units (map lookup-def-unit (syntax->list #'(u ...)))] + [import-sigs (map process-signature + (syntax->list #'(import ...)))] + [sub-outs + (map + (lambda (outs unit) + (define o + (map + (lambda (clause) + (define c (check-tagged-:-clause clause)) + (make-link-record (car c) (cadr c) (cddr c) + (signature-siginfo (lookup-signature (cddr c))))) + (syntax->list outs))) + (complete-exports (map process-tagged-sigid (unit-info-export-sig-ids unit)) + o)) + (syntax->list #'((out ...) ...)) + units)] + [link-defs (append import-sigs (apply append sub-outs))]) + + (define lnk-table (make-bound-identifier-mapping)) + (define sig-table (make-hash-table)) + + (let ([dup (check-duplicate-identifier (map link-record-linkid link-defs))]) + (when dup + (raise-stx-err "duplicate identifier" dup))) + + (for-each + (lambda (b) + (bound-identifier-mapping-put! lnk-table (link-record-linkid b) b)) + link-defs) + + (for-each + (lambda (b) + (for-each + (lambda (cid) + (define there? (hash-table-get sig-table cid (lambda () #f))) + (hash-table-put! sig-table cid (if there? 'duplicate (link-record-linkid b)))) + (siginfo-ctime-ids (link-record-siginfo b)))) + link-defs) + + (let ([sub-ins + (map + (lambda (ins unit unit-stx) + (define is (syntax->list ins)) + (define lrs + (map + (lambda (i) + (define tagged-lnkid (check-tagged-id i)) + (define sig + (bound-identifier-mapping-get lnk-table + (cdr tagged-lnkid) + (lambda () #f))) + (unless sig + (raise-stx-err "unknown linking identifier" i)) + (make-link-record (car tagged-lnkid) + (cdr tagged-lnkid) + (link-record-sigid sig) + (link-record-siginfo sig))) + is)) + (check-duplicate-subs + (map + (lambda (lr) (cons (link-record-tag lr) (link-record-siginfo lr))) + lrs) + is) + (complete-imports sig-table + lrs + (map process-tagged-sigid + (unit-info-import-sig-ids unit)) + unit-stx)) + (syntax->list #'((l ...) ...)) + units + (syntax->list #'(u ...)))] + [exports + (map + (lambda (e) + (define tid (check-tagged-id e)) + (define lookup (bound-identifier-mapping-get + lnk-table + (cdr tid) + (lambda () #f))) + (cond + [lookup (unprocess-tagged-id tid)] + [else + (let ([lnkid (hash-table-get + sig-table + (car (siginfo-ctime-ids (signature-siginfo (lookup-signature (cdr tid))))) + (lambda () #f))]) + (cond + [(not lnkid) + (raise-stx-err "no sub unit exports this signature" (cdr tid))] + [(eq? lnkid 'duplicate) + (raise-stx-err "multiple sub units export this signature" (cdr tid))] + [else + (unprocess-tagged-id + (cons (car tid) lnkid))]))])) + (syntax->list #'(export ...)))]) + (with-syntax (((import ...) + (map unprocess-link-record-bind import-sigs)) + (((out ...) ...) + (map + (lambda (out) + (map unprocess-link-record-bind out)) + sub-outs)) + (((in ...) ...) + (map + (lambda (ins) + (map unprocess-link-record-use ins)) + sub-ins)) + ((unit-id ...) (map + (lambda (u stx) + (quasisyntax/loc stx #,(unit-info-unit-id u))) + units (syntax->list #'(u ...))))) + (build-compound-unit #`((import ...) + #,exports + (((out ...) unit-id in ...) ...))))))) + (((i ...) (e ...) (l ...)) + (for-each check-link-line-syntax (syntax->list #'(l ...)))))) + + + (define-for-syntax (check-compound/infer-syntax stx) + (syntax-case (check-compound-syntax stx) () + ((i e (b ...)) + (with-syntax (((b ...) + (map + (lambda (b) + (if (identifier? b) + #`(() #,b) + b)) + (syntax->list #'(b ...))))) + #'(i e (b ...)))))) + + (define-syntax/err-param (compound-unit/infer stx) + (let-values (((u i e d) + (build-compound-unit/infer + (check-compound/infer-syntax + (syntax-case stx () ((_ . x) #'x)))))) + u)) + + (define-syntax/err-param (define-compound-unit/infer stx) + (build-define-unit stx + (lambda (clause) + (build-compound-unit/infer (check-compound/infer-syntax clause))) + "missing unit name")) + + (define-syntax/err-param (invoke-unit stx) + (syntax-case stx (import) + ((_ unit) + (syntax/loc stx + (invoke-unit/core unit))) + ((_ unit (import isig ...)) + (with-syntax (((u ...) (generate-temporaries (syntax->list #'(isig ...)))) + (((U Ul isig) ...) (map temp-id-with-tags + (generate-temporaries #'(isig ...)) + (syntax->list #'(isig ...)))) + ((isig-id ...) (map cdadr + (map process-tagged-import + (syntax->list #'(isig ...)))))) + (syntax/loc stx + (let () + (define-unit-from-context u isig) + ... + (define-compound-unit u2 (import) (export) + (link [((U : isig-id)) u] ... [() unit Ul ...])) + (invoke-unit/core u2))))) + (_ (raise-stx-err (format + "expected (~a ) or (~a (import ...))" + (syntax-e (stx-car stx)) + (syntax-e (stx-car stx))))))) + + (define-syntax/err-param (invoke-unit/infer stx) + (syntax-case stx () + ((_ u) + (let ((ui (lookup-def-unit #'u))) + (with-syntax (((isig ...) (map unprocess-tagged-id + (unit-info-import-sig-ids ui)))) + (quasisyntax/loc stx + (invoke-unit u (import isig ...)))))) + ((_) + (raise-stx-err "missing unit" stx)) + ((_ . b) + (raise-stx-err + (format "expected syntax matching (~a )" + (syntax-e (stx-car stx))))))) + + ) +;(load "test-unit.ss") diff --git a/collects/mzlib/unit200.ss b/collects/mzlib/unit200.ss new file mode 100644 index 0000000000..0a4733486e --- /dev/null +++ b/collects/mzlib/unit200.ss @@ -0,0 +1,869 @@ + +;; Unit system + +(module unit200 mzscheme + (require-for-syntax (lib "kerncase.ss" "syntax") + (lib "stx.ss" "syntax") + (lib "name.ss" "syntax") + (lib "context.ss" "syntax") + "list.ss" + "private/unitidmap.ss") + + ;; ---------------------------------------------------------------------- + ;; Structures and helpers + + (define undefined (letrec ([x x]) x)) ; initial value + + (define insp (current-inspector)) ; for named structures + + (define-struct unit (num-imports exports go)) ; unit value + (define-struct (exn:fail:unit exn:fail) ()) ; run-time exception + + ;; For units with inferred names, generate a struct that prints using the name: + (define (make-naming-constructor type name) + (let-values ([(struct: make- ? -accessor -mutator) + (make-struct-type name type 0 0 #f null insp)]) + make-)) + + ;; Make a unt value (call by the macro expansion of `unit') + (define (make-a-unit name num-imports exports go) + ((if name + (make-naming-constructor + struct:unit + (string->symbol (format "unit:~a" name))) + make-unit) + num-imports exports go)) + + ;; ---------------------------------------------------------------------- + ;; The `unit' syntactic form + + (define-syntaxes (:unit unit/no-expand) + (let ([do-unit + (lambda (stx expand?) + (syntax-case stx (import export) + [(_ (import ivar ...) + (export evar ...) + defn&expr ...) + (let ([check-id (lambda (v) + (unless (identifier? v) + (raise-syntax-error + #f + "import is not an identifier" + stx + v)))] + [check-renamed-id + (lambda (v) + (syntax-case v () + [id (identifier? (syntax id)) (list v)] + [(lid eid) (and (identifier? (syntax lid)) + (identifier? (syntax eid))) + (list #'lid #'eid)] + [else (raise-syntax-error + #f + "export is not an identifier or renamed identifier" + stx + v)]))] + [expand-context (generate-expand-context)] + [def-ctx (and expand? + (syntax-local-make-definition-context))] + [localify (lambda (ids def-ctx) + (if (andmap identifier? ids) + ;; In expand mode, add internal defn context + (if expand? + (begin + ;; Treat imports as internal-defn names: + (syntax-local-bind-syntaxes ids #f def-ctx) + (cdr (syntax->list + (local-expand #`(stop #,@ids) + 'expression + (list #'stop) + def-ctx)))) + ids) + ;; Let later checking report an error: + ids))]) + (let ([ivars (localify (syntax->list (syntax (ivar ...))) def-ctx)] + [evars (syntax->list (syntax (evar ...)))]) + (for-each check-id ivars) + (for-each check-renamed-id evars) + + ;; Get import/export declared names: + (let* ([exported-names + (localify + (map (lambda (v) + (syntax-case v () + [(lid eid) (syntax lid)] + [id (syntax id)])) + evars) + def-ctx)] + [extnames (map (lambda (v) + (syntax-case v () + [(lid eid) (syntax eid)] + [id (syntax id)])) + evars)] + [imported-names ivars] + [declared-names (append imported-names exported-names)]) + ;; Check that all exports are distinct (as symbols) + (let ([ht (make-hash-table)]) + (for-each (lambda (name) + (when (hash-table-get ht (syntax-e name) (lambda () #f)) + (raise-syntax-error + #f + "duplicate export" + stx + name)) + (hash-table-put! ht (syntax-e name) #t)) + extnames)) + + ;; Expand all body expressions + ;; so that all definitions are exposed. + (letrec ([expand-all + (if expand? + (lambda (defns&exprs) + (apply + append + (map + (lambda (defn-or-expr) + (let ([defn-or-expr + (local-expand + defn-or-expr + expand-context + (append + (kernel-form-identifier-list (quote-syntax here)) + declared-names) + def-ctx)]) + (syntax-case defn-or-expr (begin define-values define-syntaxes) + [(begin . l) + (let ([l (syntax->list (syntax l))]) + (unless l + (raise-syntax-error + #f + "bad syntax (illegal use of `.')" + defn-or-expr)) + (expand-all (map (lambda (s) + (syntax-track-origin s defn-or-expr #'begin)) + l)))] + [(define-syntaxes (id ...) rhs) + (andmap identifier? (syntax->list #'(id ...))) + (with-syntax ([rhs (local-transformer-expand + #'rhs + 'expression + null)]) + (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #'rhs def-ctx) + (list #'(define-syntaxes (id ...) rhs)))] + [(define-values (id ...) rhs) + (andmap identifier? (syntax->list #'(id ...))) + (begin + (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #f def-ctx) + (list defn-or-expr))] + [else (list defn-or-expr)]))) + defns&exprs))) + values)]) + (let ([all-expanded (expand-all (syntax->list (syntax (defn&expr ...))))]) + ;; Get all the defined names, sorting out variable definitions + ;; from syntax definitions. + (let* ([definition? + (lambda (id) + (and (identifier? id) + (or (module-identifier=? id (quote-syntax define-values)) + (module-identifier=? id (quote-syntax define-syntaxes)))))] + [all-defined-names/kinds + (apply + append + (map + (lambda (defn-or-expr) + (syntax-case defn-or-expr (define-values define-syntaxes) + [(dv (id ...) expr) + (definition? (syntax dv)) + (let ([l (syntax->list (syntax (id ...)))]) + (for-each (lambda (i) + (unless (identifier? i) + (raise-syntax-error + #f + "not an identifier in definition" + defn-or-expr + i))) + l) + (let ([key (if (module-identifier=? (syntax dv) (quote-syntax define-syntaxes)) + 'stx + 'val)]) + (map (lambda (id) (cons key id)) l)))] + [(define-values . l) + (raise-syntax-error + #f + "bad definition form" + defn-or-expr)] + [(define-syntaxes . l) + (raise-syntax-error + #f + "bad syntax definition form" + defn-or-expr)] + [else null])) + all-expanded))] + [all-defined-names (map cdr all-defined-names/kinds)] + [all-defined-val-names (map cdr + (filter (lambda (i) (eq? (car i) 'val)) + all-defined-names/kinds))]) + ;; Check that all defined names (var + stx) are distinct: + (let ([name (check-duplicate-identifier + (append imported-names all-defined-names))]) + (when name + (raise-syntax-error + #f + "variable imported and/or defined twice" + stx + name))) + ;; Check that all exported names are defined (as var): + (let ([ht (make-hash-table)] + [stx-ht (make-hash-table)]) + (for-each + (lambda (kind+name) + (let ([name (cdr kind+name)]) + (let ([l (hash-table-get ht (syntax-e name) (lambda () null))]) + (hash-table-put! (if (eq? (car kind+name) 'val) ht stx-ht) + (syntax-e name) + (cons name l))))) + all-defined-names/kinds) + (for-each + (lambda (n) + (let ([v (hash-table-get ht (syntax-e n) (lambda () null))]) + (unless (ormap (lambda (i) (bound-identifier=? i n)) v) + ;; Either not defined, or defined as syntax: + (let ([stx-v (hash-table-get stx-ht (syntax-e n) (lambda () null))]) + (if (ormap (lambda (i) (bound-identifier=? i n)) stx-v) + (raise-syntax-error + #f + "cannot export syntax from a unit" + stx + n) + (raise-syntax-error + #f + "exported variable is not defined" + stx + n)))))) + exported-names)) + + ;; Compute defined but not exported: + (let ([ht (make-hash-table)]) + (for-each + (lambda (name) + (let ([l (hash-table-get ht (syntax-e name) (lambda () null))]) + (hash-table-put! ht (syntax-e name) (cons name l)))) + exported-names) + (let ([internal-names + (let loop ([l all-defined-val-names]) + (cond + [(null? l) null] + [(let ([v (hash-table-get ht (syntax-e (car l)) (lambda () null))]) + (ormap (lambda (i) (bound-identifier=? i (car l))) v)) + (loop (cdr l))] + [else (cons (car l) (loop (cdr l)))]))]) + ;; Generate names for import/export boxes, etc: + (with-syntax ([(ivar ...) ivars] + [(iloc ...) (generate-temporaries ivars)] + [(eloc ...) (generate-temporaries evars)] + [(extname ...) extnames] + [(expname ...) exported-names] + [(intname ...) internal-names]) + ;; Change all definitions to set!s. Convert evars to set-box!, + ;; because set! on exported variables is not allowed. + (with-syntax ([(defn&expr ...) + (let ([elocs (syntax->list (syntax (eloc ...)))]) + (filter + values + (map (lambda (defn-or-expr) + (syntax-case defn-or-expr (define-values define-syntaxes) + [(define-values ids expr) + (let* ([ids (syntax->list (syntax ids))]) + (if (null? ids) + (syntax/loc defn-or-expr (set!-values ids expr)) + (let ([do-one + (lambda (id tmp name) + (let loop ([evars exported-names] + [elocs elocs]) + (cond + [(null? evars) + ;; not an exported id + (with-syntax ([id id][tmp tmp]) + (syntax/loc + defn-or-expr + (set! id tmp)))] + [(bound-identifier=? (car evars) id) + ;; set! exported id: + (with-syntax + ([loc (car elocs)] + [tmp + (if name + (with-syntax + ([tmp tmp] + [name name]) + (syntax + (let ([name tmp]) + name))) + tmp)]) + (syntax/loc defn-or-expr + (set-box! loc tmp)))] + [else (loop (cdr evars) + (cdr elocs))])))]) + (if (null? (cdr ids)) + (do-one (car ids) (syntax expr) (car ids)) + (let ([tmps (generate-temporaries ids)]) + (with-syntax ([(tmp ...) tmps] + [(set ...) + (map (lambda (id tmp) + (do-one id tmp #f)) + ids tmps)]) + (syntax/loc defn-or-expr + (let-values ([(tmp ...) expr]) + set ...))))))))] + [(define-syntaxes . l) #f] + [else defn-or-expr])) + all-expanded)))] + [(stx-defn ...) + (filter + values + (map (lambda (defn-or-expr) + (syntax-case defn-or-expr (define-syntaxes) + [(define-syntaxes . l) #'l] + [else #f])) + all-expanded))]) + ;; Build up set! redirection chain: + (with-syntax ([redirections + (let ([varlocs + (syntax->list + (syntax ((ivar iloc) ... (expname eloc) ...)))]) + (with-syntax ([vars (map stx-car varlocs)] + [rhss + (map + (lambda (varloc) + (with-syntax ([(var loc) varloc]) + (syntax + (make-id-mapper (quote-syntax (unbox loc)) + (quote-syntax var))))) + varlocs)]) + (syntax + ([vars (values . rhss)]))))] + [num-imports (datum->syntax-object + (quote-syntax here) + (length (syntax->list (syntax (iloc ...)))) + #f)] + [name (syntax-local-infer-name stx)]) + (syntax/loc stx + (make-a-unit + 'name + num-imports + (list (quote extname) ...) + (lambda () + (let ([eloc (box undefined)] ...) + (list (vector eloc ...) + (lambda (iloc ...) + (letrec-syntaxes+values + (stx-defn ... . redirections) + ([(intname) undefined] ...) + (void) ; in case the body would be empty + defn&expr ...))))))))))))))))))]))]) + (values (lambda (stx) (do-unit stx #t)) + (lambda (stx) (do-unit stx #f))))) + + ;; ---------------------------------------------------------------------- + ;; check-expected-interface: used by the expansion of `compound-unit' + + (define (check-expected-interface tag unit num-imports exports) + (unless (unit? unit) + (raise + (make-exn:fail:unit + (string->immutable-string + (format "compound-unit: result of expression for tag ~s not a unit: ~e" tag unit)) + (current-continuation-marks)))) + (unless (= num-imports (unit-num-imports unit)) + (raise + (make-exn:fail:unit + (string->immutable-string + (format "compound-unit: unit for tag ~s expects ~a imports, given ~a" + tag + (unit-num-imports unit) + num-imports)) + (current-continuation-marks)))) + (list->vector + (map (lambda (ex) + (let loop ([l (unit-exports unit)][i 0]) + (cond + [(null? l) + (raise + (make-exn:fail:unit + (string->immutable-string + (format "compound-unit: unit for tag ~s has no ~s export" + tag ex)) + (current-continuation-marks)))] + [(eq? (car l) ex) + i] + [else (loop (cdr l) (add1 i))]))) + exports))) + + ;; ---------------------------------------------------------------------- + ;; The `compound-unit' syntactic form + + (define-syntax compound-unit + (lambda (stx) + (syntax-case stx (import export link) + [(_ (import ivar ...) + (link [tag (unit-expr linkage ...)] ...) + (export exportage ...)) + (let ([check-id (lambda (v) + (unless (identifier? v) + (raise-syntax-error + #f + "import is not an identifier" + stx + v)))] + [check-tag (lambda (v) + (unless (identifier? v) + (raise-syntax-error + #f + "tag is not an identifier" + stx + v)))] + [check-linkage (lambda (v) + (syntax-case v () + [id (identifier? (syntax id)) #t] + [(tag id ...) + (for-each (lambda (v) + (unless (identifier? v) + (raise-syntax-error + #f + "non-identifier in linkage" + stx + v))) + (syntax->list v))] + [else + (raise-syntax-error + #f + "ill-formed linkage" + stx + v)]))] + [check-exportage (lambda (v) + (syntax-case v () + [(tag ex ...) + (begin + (unless (identifier? (syntax tag)) + (raise-syntax-error + #f + "export tag is not an identifier" + stx + (syntax tag))) + (for-each + (lambda (e) + (syntax-case e () + [id (identifier? (syntax id)) #t] + [(iid eid) + (begin + (unless (identifier? (syntax iid)) + (raise-syntax-error + #f + "export internal name is not an identifier" + stx + (syntax iid))) + (unless (identifier? (syntax eid)) + (raise-syntax-error + #f + "export internal name is not an identifier" + stx + (syntax eid))))] + [else + (raise-syntax-error + #f + (format "ill-formed export with tag ~a" + (syntax-e (syntax tag))) + stx + e)])) + (syntax->list (syntax (ex ...)))))] + [else + (raise-syntax-error + #f + "ill-formed export" + stx + v)]))] + [imports (syntax->list (syntax (ivar ...)))] + [tags (syntax->list (syntax (tag ...)))] + [linkages (map syntax->list (syntax->list (syntax ((linkage ...) ...))))] + [exports (syntax->list (syntax (exportage ...)))]) + ;; Syntax checks: + (for-each check-id imports) + (for-each check-tag tags) + (for-each (lambda (l) (for-each check-linkage l)) linkages) + (for-each check-exportage exports) + ;; Check for duplicate imports + (let ([dup (check-duplicate-identifier imports)]) + (when dup + (raise-syntax-error + #f + "duplicate import" + stx + dup))) + ;; Check for duplicate tags + (let ([dup (check-duplicate-identifier tags)]) + (when dup + (raise-syntax-error + #f + "duplicate tag" + stx + dup))) + ;; Check referenced imports and tags + (let ([check-linkage-refs (lambda (v) + (syntax-case v () + [(tag . exs) + (unless (ormap (lambda (t) + (bound-identifier=? t (syntax tag))) + tags) + (raise-syntax-error + #f + "linkage tag is not bound" + stx + (syntax tag)))] + [id (unless (ormap (lambda (i) + (bound-identifier=? i (syntax id))) + imports) + (raise-syntax-error + #f + "no imported identified for linkage" + stx + (syntax id)))]))] + [check-export-refs (lambda (v) + (syntax-case v () + [(tag . r) + (unless (ormap (lambda (t) + (bound-identifier=? t (syntax tag))) + tags) + (raise-syntax-error + #f + "export tag is not bound" + stx + (syntax tag)))]))]) + (for-each (lambda (l) (for-each check-linkage-refs l)) + linkages) + (for-each check-export-refs exports) + ;; Get all export names, and check for duplicates + (let ([export-names + (apply + append + (map + (lambda (v) + (syntax-case v () + [(tag . exs) + (map + (lambda (e) + (syntax-case e () + [(iid eid) (syntax eid)] + [id e])) + (syntax->list (syntax exs)))])) + exports))]) + (let ([dup (check-duplicate-identifier export-names)]) + (when dup + (raise-syntax-error + #f + "duplicate export" + stx + dup))) + + (let ([constituents (generate-temporaries tags)] + [unit-export-positionss (generate-temporaries tags)] + [unit-setups (generate-temporaries tags)] + [unit-extracts (generate-temporaries tags)] + [unit-export-lists + ;; For each tag, get all expected exports + (let* ([hts (map (lambda (x) (make-hash-table)) tags)] + [get-add-name + (lambda (tag) + (ormap (lambda (t ht) + (and (bound-identifier=? t tag) + (lambda (name) + (hash-table-put! ht (syntax-e name) name)))) + tags hts))]) + ;; Walk though linkages + (for-each + (lambda (linkage-list) + (for-each + (lambda (linkage) + (syntax-case linkage () + [(tag . ids) + (let ([add-name (get-add-name (syntax tag))]) + (for-each add-name (syntax->list (syntax ids))))] + [else (void)])) + linkage-list)) + linkages) + ;; Walk through exports + (for-each + (lambda (v) + (syntax-case v () + [(tag . exs) + (let ([add-name (get-add-name (syntax tag))]) + (for-each + (lambda (e) + (syntax-case e () + [(iid eid) (add-name (syntax iid))] + [id (add-name (syntax id))])) + (syntax->list (syntax exs))))])) + exports) + ;; Extract names from hash tables + (map (lambda (ht) + (hash-table-map ht (lambda (k v) v))) + hts))]) + ;; Map exports to imports and indices based on expected unit exports + (let ([map-tag (lambda (t l) + (let loop ([tags tags][l l]) + (if (bound-identifier=? (car tags) t) + (car l) + (loop (cdr tags) (cdr l)))))] + [unit-export-hts (map (lambda (export-list) + (let ([ht (make-hash-table)]) + (let loop ([l export-list][p 0]) + (unless (null? l) + (hash-table-put! ht (syntax-e (car l)) p) + (loop (cdr l) (add1 p)))) + ht)) + unit-export-lists)] + [interned-integer-lists null] + [interned-id-lists null]) + (let ([make-mapping + (lambda (v) + (syntax-case v () + [(tag . exs) + (let ([extract (map-tag (syntax tag) + unit-extracts)] + [ht (map-tag (syntax tag) + unit-export-hts)]) + (with-syntax ([extract extract] + [pos-name + (let ([il + (map + (lambda (e) + (hash-table-get + ht + (syntax-e + (syntax-case e () + [(iid eid) (syntax iid)] + [id e])))) + (syntax->list (syntax exs)))]) + (or (ormap (lambda (i) + (and (equal? il (cadadr i)) + (car i))) + interned-integer-lists) + (let ([name (car (generate-temporaries + (list (syntax tag))))]) + (set! interned-integer-lists + (cons `(,name ',il) + interned-integer-lists)) + name)))]) + (syntax (map extract pos-name))))] + [import v]))] + [collapse (lambda (l) + (let loop ([l l]) + (cond + [(null? l) null] + [(identifier? (car l)) + (let-values ([(ids rest) + (let loop ([l l][ids null]) + (if (or (null? l) + (not (identifier? (car l)))) + (values (reverse ids) l) + (loop (cdr l) (cons (car l) ids))))]) + (let ([name + (let ([id-syms (map syntax-e ids)]) + (or (ormap (lambda (i) + (and (equal? id-syms (cadr i)) + (car i))) + interned-id-lists) + (let ([name + (car (generate-temporaries (list 'ids)))]) + (set! interned-id-lists + (cons (list* name id-syms ids) + interned-id-lists)) + name)))]) + (cons name + (loop rest))))] + [else (cons (car l) (loop (cdr l)))])))]) + (let ([export-mapping (collapse (map make-mapping exports))] + [import-mappings (map (lambda (linkage-list) + (collapse + (map make-mapping linkage-list))) + linkages)]) + (with-syntax ([(constituent ...) constituents] + [(unit-export-positions ...) unit-export-positionss] + [(unit-setup ...) unit-setups] + [(unit-extract ...) unit-extracts] + [interned-integer-lists interned-integer-lists] + [interned-id-lists (map (lambda (i) + (with-syntax ([name (car i)] + [ids (cddr i)]) + (syntax [name (list . ids)]))) + interned-id-lists)] + [(unit-export-list ...) unit-export-lists] + [(import-mapping ...) import-mappings] + [(unit-import-count ...) + (map (lambda (l) + (datum->syntax-object + (quote-syntax here) + (apply + + + (map (lambda (v) + (if (identifier? v) + 1 + (length (cdr (syntax->list v))))) + l)) + #f)) + linkages)] + [num-imports (datum->syntax-object + (quote-syntax here) + (length imports) + #f)] + [export-names export-names] + [export-mapping export-mapping] + [name (syntax-local-infer-name stx)]) + (syntax/loc + stx + (let ([constituent unit-expr] + ...) + (let ([unit-export-positions + (check-expected-interface + 'tag + constituent + unit-import-count + 'unit-export-list)] + ...) + (make-a-unit + 'name + num-imports + (quote export-names) + (lambda () + (let ([unit-setup ((unit-go constituent))] ...) + (let ([unit-extract + (lambda (pos) + (vector-ref (car unit-setup) + (vector-ref unit-export-positions pos)))] + ... + . + interned-integer-lists) + (list (list->vector (append . export-mapping)) + (lambda (ivar ...) + (let interned-id-lists + (void) ;; in case there are no units + (apply (list-ref unit-setup 1) + (append . import-mapping)) + ...))))))))))))))))))]))) + + ;; ---------------------------------------------------------------------- + ;; check-unit: used by the expansion of `invoke-unit' + + (define (check-unit u n) + (unless (unit? u) + (raise + (make-exn:fail:unit + (string->immutable-string + (format "invoke-unit: result of unit expression was not a unit: ~e" u)) + (current-continuation-marks)))) + (unless (= (unit-num-imports u) n) + (raise + (make-exn:fail:unit + (string->immutable-string + (format "invoke-unit: expected a unit with ~a imports, given one with ~a imports" + n (unit-num-imports u))) + (current-continuation-marks))))) + + ;; ---------------------------------------------------------------------- + ;; The `invoke-unit' syntactic form + + (define-syntax invoke-unit + (lambda (stx) + (syntax-case stx (import export) + [(_ unit-expr expr ...) + (let ([exprs (syntax (expr ...))]) + (with-syntax ([(bx ...) (generate-temporaries (syntax (expr ...)))] + [num (datum->syntax-object + (quote-syntax here) + (length (syntax->list exprs)) + #f)]) + (syntax/loc + stx + (let ([u unit-expr]) + (check-unit u num) + (let ([bx (box expr)] ...) + ((list-ref ((unit-go u)) 1) + bx ...))))))]))) + + (define-syntaxes (define-values/invoke-unit + namespace-variable-bind/invoke-unit) + (let ([mk + (lambda (global?) + (lambda (stx) + (syntax-case stx () + [(_ exports unite . prefix+imports) + (let* ([badsyntax (lambda (s why) + (raise-syntax-error + #f + (format "bad syntax (~a)" why) + stx + s))] + [symcheck (lambda (s) + (or (identifier? s) + (badsyntax s "not an identifier")))]) + (unless (stx-list? (syntax exports)) + (badsyntax (syntax exports) "not a sequence of identifiers")) + (for-each symcheck (syntax->list (syntax exports))) + (let ([prefix (if (stx-null? (syntax prefix+imports)) + #f + (stx-car (syntax prefix+imports)))]) + (unless (or (not prefix) + (not (syntax-e prefix)) + (identifier? prefix)) + (badsyntax prefix "prefix is not an identifier")) + (for-each symcheck (let ([v (syntax prefix+imports)]) + (cond + [(stx-null? v) null] + [(stx-list? v) (cdr (syntax->list v))] + [else + (badsyntax (syntax prefix+imports) "illegal use of `.'")]))) + (with-syntax ([(tagged-export ...) + (if (and prefix (syntax-e prefix)) + (let ([prefix (string-append + (symbol->string + (syntax-e prefix)) + ":")]) + (map (lambda (s) + (datum->syntax-object + s + (string->symbol + (string-append + prefix + (symbol->string (syntax-e s)))) + s)) + (syntax->list (syntax exports)))) + (syntax exports))] + [extract-unit (syntax (:unit + (import . exports) + (export) + (values . exports)))]) + (with-syntax ([invoke-unit (with-syntax ([(x . imports) + (if prefix + (syntax prefix+imports) + `(#f))]) + (syntax (invoke-unit + (compound-unit + (import . imports) + (link [unit-to-invoke (unite . imports)] + [export-extractor + (extract-unit (unit-to-invoke . exports))]) + (export)) + . imports)))]) + (if global? + (syntax (let-values ([(tagged-export ...) invoke-unit]) + (namespace-set-variable-value! 'tagged-export tagged-export) + ... + (void))) + (syntax (define-values (tagged-export ...) invoke-unit)))))))])))]) + (values (mk #f) (mk #t)))) + + (provide (rename :unit unit) unit/no-expand + compound-unit invoke-unit unit? + (struct exn:fail:unit ()) + + define-values/invoke-unit + namespace-variable-bind/invoke-unit)) diff --git a/collects/mzlib/unitsig.ss b/collects/mzlib/unitsig.ss index 3e2a82ddd0..c6fc7bb343 100644 --- a/collects/mzlib/unitsig.ss +++ b/collects/mzlib/unitsig.ss @@ -1,360 +1,4 @@ -;; This implementation of `unit/sig' was ported from the old v100 -;; implementation, and then hacked a bit to produce more compact -;; output, and finally mangled to handle the v200 `struct' (with -;; compile-time information). It's in dire need of an overhaul. - (module unitsig mzscheme - (require "unit.ss") - (require "private/sigmatch.ss") - - (require-for-syntax "private/sigutil.ss") - (require-for-syntax "private/sigmatch.ss") - (require-for-syntax (lib "kerncase.ss" "syntax")) - - (define-struct signed-unit (unit imports exports)) - - (define-syntax define-signature - (lambda (expr) - (syntax-case expr () - [(_ name sig) - (identifier? (syntax name)) - (let ([sig (get-sig 'define-signature expr (syntax-e (syntax name)) - (syntax sig) #f)]) - (with-syntax ([content (explode-sig sig #f)]) - (syntax (define-syntax name - (make-sig (quote content))))))]))) - - (define-syntax let-signature - (lambda (expr) - (syntax-case expr () - [(_ name sig . body) - (identifier? (syntax name)) - (let ([sig (get-sig 'let-signature expr (syntax-e (syntax name)) - (syntax sig) #f)]) - (with-syntax ([content (explode-sig sig #f)]) - (syntax (letrec-syntax ([name (make-sig (quote content))]) - . body))))]))) - - (define-syntax unit/sig - (lambda (expr) - (syntax-case expr () - [(_ sig . rest) - (let ([sig (get-sig 'unit/sig expr #f (syntax sig) #f)]) - (let ([a-unit (parse-unit expr (syntax rest) sig - (kernel-form-identifier-list (quote-syntax here)) - (quote-syntax define-values) - (quote-syntax define-syntaxes) - (quote-syntax begin))]) - (check-signature-unit-body sig a-unit (parsed-unit-renames a-unit) 'unit/sig expr) - (with-syntax ([imports (parsed-unit-import-vars a-unit)] - [exports (datum->syntax-object - expr - (let ([vars (make-hash-table)]) - (for-each (lambda (var) - (hash-table-put! vars (syntax-e var) var)) - (parsed-unit-vars a-unit)) - (map - (lambda (name) - (list (let ([name (do-rename name (parsed-unit-renames a-unit))]) - (hash-table-get vars name name)) - name)) - (signature-vars sig))) - expr)] - [body (append - (reverse! (parsed-unit-body a-unit)) - ((parsed-unit-stx-checks a-unit) expr))] - [import-sigs (explode-named-sigs (parsed-unit-imports a-unit) #f)] - [export-sig (explode-sig sig #f)]) - (syntax/loc expr - (make-signed-unit - (unit/no-expand - (import . imports) - (export . exports) - . body) - (quote import-sigs) - (quote export-sig))))))]))) - - (define-syntax compound-unit/sig - (lambda (expr) - (syntax-case expr () - [(_ . body) - (let-values ([(tags - exprs - exploded-link-imports - exploded-link-exports - flat-imports - link-imports - flat-exports - exploded-imports - exploded-exports - boxed-interned-symbol-vectors) - (parse-compound-unit expr (syntax body))] - [(t) (lambda (l) (datum->syntax-object expr l expr))]) - (with-syntax ([(tag ...) (t tags)] - [(uexpr ...) (t exprs)] - [(tagx ...) (t (map (lambda (t) (string->symbol (format "u:~a" t))) tags))] - [exploded-link-imports (t exploded-link-imports)] - [exploded-link-exports (t exploded-link-exports)] - [flat-imports (t flat-imports)] - [(link-import ...) (t link-imports)] - [flat-exports (t flat-exports)] - [exploded-imports (t exploded-imports)] - [exploded-exports (t exploded-exports)] - [interned-vectors (t (map (lambda (x) `(,(car x) (quote ,(cadr x)))) - (unbox boxed-interned-symbol-vectors)))]) - (syntax/loc - expr - (let ([tagx uexpr] ... . interned-vectors) - (alt-verify-linkage-signature-match - 'compound-unit/sig - '(tag ...) - (list tagx ...) - `exploded-link-imports - `exploded-link-exports) - ;; All checks done. Make the unit: - (make-signed-unit - (compound-unit - (import . flat-imports) - (link [tag ((signed-unit-unit tagx) - . link-import)] - ...) - (export . flat-exports)) - `exploded-imports - `exploded-exports)))))]))) - - (define-syntax invoke-unit/sig - (lambda (expr) - (syntax-case expr () - [(_ u sig ...) - (let ([sigs (parse-invoke-vars 'invoke-unit/sig (syntax (sig ...)) expr)]) - (with-syntax ([exploded-sigs (datum->syntax-object - expr - (explode-named-sigs sigs #f) - expr)] - [flat-sigs (datum->syntax-object - expr - (flatten-signatures sigs #f) - expr)]) - (syntax/loc - expr - (let ([unt u]) - (alt-verify-linkage-signature-match - (quote invoke-unit/sig) - (quote (invoke)) - (list unt) - (quote ((#() . #()))) - (quote (exploded-sigs))) - (invoke-unit (signed-unit-unit unt) - . flat-sigs)))))]))) - - (define-syntax unit->unit/sig - (lambda (expr) - (syntax-case expr () - [(_ e (im-sig ...) ex-sig) - (let ([im-sigs (map (lambda (sig) - (get-sig 'unit->unit/sig expr #f sig #f)) - (syntax->list (syntax (im-sig ...))))] - [ex-sig (get-sig 'unit->unit/sig expr #f (syntax ex-sig) #f)]) - (with-syntax ([exploded-imports (datum->syntax-object - expr - (explode-named-sigs im-sigs #f) - expr)] - [exploded-exports (datum->syntax-object - expr - (explode-sig ex-sig #f) - expr)]) - (syntax - (make-signed-unit - e - (quote exploded-imports) - (quote exploded-exports)))))]))) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - (define -verify-linkage-signature-match - (let ([make-exn make-exn:fail:unit] - [p-suffix (lambda (pos) (case pos [(1) 'st][(2) 'nd][(3) 'rd][else 'th]))]) - (lambda (who tags units esigs isigs wrapped? unwrap) - (for-each - (lambda (u tag) - (unless (signed-unit? u) - (raise - (make-exn - (string->immutable-string - (format - "~s: expression for \"~s\" is not a signed unit: ~e" - who tag u)) - (current-continuation-marks))))) - units tags) - (for-each - (lambda (u tag esig) - (-verify-signature-match - who #f - (format "specified export signature for ~a" tag) - esig - (format "export signature for actual ~a sub-unit" tag) - (signed-unit-exports u) - wrapped? unwrap)) - units tags esigs) - (for-each - (lambda (u tag isig) - (let ([n (length (signed-unit-imports u))] - [c (length isig)]) - (unless (= c n) - (raise - (make-exn - (string->immutable-string - (format - "~s: ~a unit imports ~a units, but ~a units were provided" - who tag n c)) - (current-continuation-marks)))))) - units tags isigs) - (for-each - (lambda (u tag isig) - (let loop ([isig isig][expecteds (signed-unit-imports u)][pos 1]) - (unless (null? isig) - (let ([expected (car expecteds)] - [provided (car isig)]) - (-verify-signature-match - who #t - (format "~a unit's ~s~s import (which is ~a)" tag - pos (p-suffix pos) - (car expected)) - (cdr expected) - (format "~a's ~s~s linkage (which is ~a)" - tag - pos (p-suffix pos) - (car provided)) - (cdr provided) - wrapped? unwrap) - (loop (cdr isig) (cdr expecteds) (add1 pos)))))) - units tags isigs)))) - - (define verify-linkage-signature-match - (lambda (who tags units esigs isigs) - (-verify-linkage-signature-match who tags units esigs isigs values values))) - - (define alt-verify-linkage-signature-match - (lambda (who tags units esigs isigs) - (-verify-linkage-signature-match who tags units esigs isigs pair? car))) - - (define-syntax signature->symbols - (lambda (stx) - (syntax-case stx () - [(_ name) - (identifier? (syntax name)) - (let ([sig (get-sig 'signature->symbols stx #f (syntax name) #f)]) - (with-syntax ([e (let cleanup ([p (explode-sig sig #f)]) - ;; Strip struct info: - (list->vector - (map (lambda (i) - (if (symbol? i) - i - (cons (car i) (cleanup (cdr i))))) - (vector->list (car p)))))]) - (syntax 'e)))]))) - - ;; Internal: - (define-syntax do-define-values/invoke-unit/sig - (lambda (stx) - (syntax-case stx () - [(_ global? signame unite prefix imports orig) - (let* ([formname (if (syntax-e (syntax global?)) - 'namespace-variable-bind/invoke-unit/sig - 'define-values/invoke-unit/sig)] - [badsyntax (lambda (s why) - (raise-syntax-error - #f - (format "bad syntax (~a)" why) - (syntax orig) - s))]) - (unless (or (not (syntax-e (syntax prefix))) - (identifier? (syntax prefix))) - (badsyntax (syntax prefix) "prefix is not an identifier")) - (let ([ex-sig (get-sig formname (syntax orig) #f (syntax signame) (syntax signame))]) - (let ([ex-exploded (explode-sig ex-sig #f)] - [ex-flattened (flatten-signature #f ex-sig #'signame)]) - (let ([im-sigs - (parse-invoke-vars formname (syntax imports) (syntax orig))]) - (let ([im-explodeds (explode-named-sigs im-sigs #f)] - [im-flattened (flatten-signatures im-sigs #f)] - [d->s (lambda (x) (datum->syntax-object (syntax orig) x (syntax orig)))]) - (with-syntax ([dv/iu (if (syntax-e (syntax global?)) - (quote-syntax namespace-variable-bind/invoke-unit) - (quote-syntax define-values/invoke-unit))] - [ex-flattened ex-flattened] - [ex-exploded (d->s ex-exploded)] - [im-explodeds (d->s im-explodeds)] - [im-flattened (d->s im-flattened)] - [formname formname] - [stx-decls (if (syntax-e (syntax global?)) - null - (make-struct-stx-decls ex-sig #f #f (syntax signame) #f))]) - (syntax/loc stx - (begin - (dv/iu - ex-flattened - (let ([unit-var unite]) - (alt-verify-linkage-signature-match - 'formname - '(invoke) - (list unit-var) - '(ex-exploded) - '(im-explodeds)) - (signed-unit-unit unit-var)) - prefix - . im-flattened) - . stx-decls))))))))]))) - - (define-syntax define-values/invoke-unit/sig - (lambda (stx) - (with-syntax ([orig stx]) - (syntax-case stx () - [(_ signame unit prefix . imports) - (syntax (do-define-values/invoke-unit/sig #f signame unit prefix imports orig))] - [(_ signame unit) - (syntax (do-define-values/invoke-unit/sig #f signame unit #f () orig))])))) - - (define-syntax namespace-variable-bind/invoke-unit/sig - (lambda (stx) - (with-syntax ([orig stx]) - (syntax-case stx () - [(_ signame unit prefix . imports) - (syntax (do-define-values/invoke-unit/sig #t signame unit prefix imports orig))] - [(_ signame unit) - (syntax (do-define-values/invoke-unit/sig #t signame unit #f () orig))])))) - - (define-syntax provide-signature-elements - (lambda (stx) - (with-syntax ([orig stx]) - (syntax-case stx () - [(_ signame) - (let ([sig (get-sig 'provide-signature-elements stx #f (syntax signame) (syntax signame))]) - (let ([flattened (flatten-signature #f sig (syntax signame))] - [structs (map struct-def-name (signature-structs sig))]) - (with-syntax ([flattened (map (lambda (x) (datum->syntax-object (syntax signame) x #f)) - (append flattened structs))]) - (syntax/loc stx - (provide . flattened)))))])))) - - (define (unit/sig? x) (signed-unit? x)) - (define (unit/sig->unit x) (signed-unit-unit x)) - - (provide define-signature - let-signature - unit/sig - compound-unit/sig - invoke-unit/sig - unit->unit/sig - signature->symbols - verify-signature-match - verify-linkage-signature-match - - (struct signed-unit (unit imports exports)) - unit/sig? unit/sig->unit - - define-values/invoke-unit/sig - namespace-variable-bind/invoke-unit/sig - provide-signature-elements)) - + (require (lib "unitsig200.ss")) + (provide (all-from (lib "unitsig200.ss")))) diff --git a/collects/mzlib/unitsig200.ss b/collects/mzlib/unitsig200.ss new file mode 100644 index 0000000000..551b0d1a3e --- /dev/null +++ b/collects/mzlib/unitsig200.ss @@ -0,0 +1,359 @@ + +;; This implementation of `unit/sig' was ported from the old v100 +;; implementation, and then hacked a bit to produce more compact +;; output, and finally mangled to handle the v200 `struct' (with +;; compile-time information). It's in dire need of an overhaul. + +(module unitsig200 mzscheme + (require "unit200.ss") + (require "private/sigmatch.ss") + + (require-for-syntax "private/sigutil.ss") + (require-for-syntax "private/sigmatch.ss") + (require-for-syntax (lib "kerncase.ss" "syntax")) + + (define-struct signed-unit (unit imports exports)) + + (define-syntax define-signature + (lambda (expr) + (syntax-case expr () + [(_ name sig) + (identifier? (syntax name)) + (let ([sig (get-sig 'define-signature expr (syntax-e (syntax name)) + (syntax sig) #f)]) + (with-syntax ([content (explode-sig sig #f)]) + (syntax (define-syntax name + (make-sig (quote content))))))]))) + + (define-syntax let-signature + (lambda (expr) + (syntax-case expr () + [(_ name sig . body) + (identifier? (syntax name)) + (let ([sig (get-sig 'let-signature expr (syntax-e (syntax name)) + (syntax sig) #f)]) + (with-syntax ([content (explode-sig sig #f)]) + (syntax (letrec-syntax ([name (make-sig (quote content))]) + . body))))]))) + + (define-syntax unit/sig + (lambda (expr) + (syntax-case expr () + [(_ sig . rest) + (let ([sig (get-sig 'unit/sig expr #f (syntax sig) #f)]) + (let ([a-unit (parse-unit expr (syntax rest) sig + (kernel-form-identifier-list (quote-syntax here)) + (quote-syntax define-values) + (quote-syntax define-syntaxes) + (quote-syntax begin))]) + (check-signature-unit-body sig a-unit (parsed-unit-renames a-unit) 'unit/sig expr) + (with-syntax ([imports (parsed-unit-import-vars a-unit)] + [exports (datum->syntax-object + expr + (let ([vars (make-hash-table)]) + (for-each (lambda (var) + (hash-table-put! vars (syntax-e var) var)) + (parsed-unit-vars a-unit)) + (map + (lambda (name) + (list (let ([name (do-rename name (parsed-unit-renames a-unit))]) + (hash-table-get vars name name)) + name)) + (signature-vars sig))) + expr)] + [body (append + (reverse! (parsed-unit-body a-unit)) + ((parsed-unit-stx-checks a-unit) expr))] + [import-sigs (explode-named-sigs (parsed-unit-imports a-unit) #f)] + [export-sig (explode-sig sig #f)]) + (syntax/loc expr + (make-signed-unit + (unit/no-expand + (import . imports) + (export . exports) + . body) + (quote import-sigs) + (quote export-sig))))))]))) + + (define-syntax compound-unit/sig + (lambda (expr) + (syntax-case expr () + [(_ . body) + (let-values ([(tags + exprs + exploded-link-imports + exploded-link-exports + flat-imports + link-imports + flat-exports + exploded-imports + exploded-exports + boxed-interned-symbol-vectors) + (parse-compound-unit expr (syntax body))] + [(t) (lambda (l) (datum->syntax-object expr l expr))]) + (with-syntax ([(tag ...) (t tags)] + [(uexpr ...) (t exprs)] + [(tagx ...) (t (map (lambda (t) (string->symbol (format "u:~a" t))) tags))] + [exploded-link-imports (t exploded-link-imports)] + [exploded-link-exports (t exploded-link-exports)] + [flat-imports (t flat-imports)] + [(link-import ...) (t link-imports)] + [flat-exports (t flat-exports)] + [exploded-imports (t exploded-imports)] + [exploded-exports (t exploded-exports)] + [interned-vectors (t (map (lambda (x) `(,(car x) (quote ,(cadr x)))) + (unbox boxed-interned-symbol-vectors)))]) + (syntax/loc + expr + (let ([tagx uexpr] ... . interned-vectors) + (alt-verify-linkage-signature-match + 'compound-unit/sig + '(tag ...) + (list tagx ...) + `exploded-link-imports + `exploded-link-exports) + ;; All checks done. Make the unit: + (make-signed-unit + (compound-unit + (import . flat-imports) + (link [tag ((signed-unit-unit tagx) + . link-import)] + ...) + (export . flat-exports)) + `exploded-imports + `exploded-exports)))))]))) + + (define-syntax invoke-unit/sig + (lambda (expr) + (syntax-case expr () + [(_ u sig ...) + (let ([sigs (parse-invoke-vars 'invoke-unit/sig (syntax (sig ...)) expr)]) + (with-syntax ([exploded-sigs (datum->syntax-object + expr + (explode-named-sigs sigs #f) + expr)] + [flat-sigs (datum->syntax-object + expr + (flatten-signatures sigs #f) + expr)]) + (syntax/loc + expr + (let ([unt u]) + (alt-verify-linkage-signature-match + (quote invoke-unit/sig) + (quote (invoke)) + (list unt) + (quote ((#() . #()))) + (quote (exploded-sigs))) + (invoke-unit (signed-unit-unit unt) + . flat-sigs)))))]))) + + (define-syntax unit->unit/sig + (lambda (expr) + (syntax-case expr () + [(_ e (im-sig ...) ex-sig) + (let ([im-sigs (map (lambda (sig) + (get-sig 'unit->unit/sig expr #f sig #f)) + (syntax->list (syntax (im-sig ...))))] + [ex-sig (get-sig 'unit->unit/sig expr #f (syntax ex-sig) #f)]) + (with-syntax ([exploded-imports (datum->syntax-object + expr + (explode-named-sigs im-sigs #f) + expr)] + [exploded-exports (datum->syntax-object + expr + (explode-sig ex-sig #f) + expr)]) + (syntax + (make-signed-unit + e + (quote exploded-imports) + (quote exploded-exports)))))]))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define -verify-linkage-signature-match + (let ([make-exn make-exn:fail:unit] + [p-suffix (lambda (pos) (case pos [(1) 'st][(2) 'nd][(3) 'rd][else 'th]))]) + (lambda (who tags units esigs isigs wrapped? unwrap) + (for-each + (lambda (u tag) + (unless (signed-unit? u) + (raise + (make-exn + (string->immutable-string + (format + "~s: expression for \"~s\" is not a signed unit: ~e" + who tag u)) + (current-continuation-marks))))) + units tags) + (for-each + (lambda (u tag esig) + (-verify-signature-match + who #f + (format "specified export signature for ~a" tag) + esig + (format "export signature for actual ~a sub-unit" tag) + (signed-unit-exports u) + wrapped? unwrap)) + units tags esigs) + (for-each + (lambda (u tag isig) + (let ([n (length (signed-unit-imports u))] + [c (length isig)]) + (unless (= c n) + (raise + (make-exn + (string->immutable-string + (format + "~s: ~a unit imports ~a units, but ~a units were provided" + who tag n c)) + (current-continuation-marks)))))) + units tags isigs) + (for-each + (lambda (u tag isig) + (let loop ([isig isig][expecteds (signed-unit-imports u)][pos 1]) + (unless (null? isig) + (let ([expected (car expecteds)] + [provided (car isig)]) + (-verify-signature-match + who #t + (format "~a unit's ~s~s import (which is ~a)" tag + pos (p-suffix pos) + (car expected)) + (cdr expected) + (format "~a's ~s~s linkage (which is ~a)" + tag + pos (p-suffix pos) + (car provided)) + (cdr provided) + wrapped? unwrap) + (loop (cdr isig) (cdr expecteds) (add1 pos)))))) + units tags isigs)))) + + (define verify-linkage-signature-match + (lambda (who tags units esigs isigs) + (-verify-linkage-signature-match who tags units esigs isigs values values))) + + (define alt-verify-linkage-signature-match + (lambda (who tags units esigs isigs) + (-verify-linkage-signature-match who tags units esigs isigs pair? car))) + + (define-syntax signature->symbols + (lambda (stx) + (syntax-case stx () + [(_ name) + (identifier? (syntax name)) + (let ([sig (get-sig 'signature->symbols stx #f (syntax name) #f)]) + (with-syntax ([e (let cleanup ([p (explode-sig sig #f)]) + ;; Strip struct info: + (list->vector + (map (lambda (i) + (if (symbol? i) + i + (cons (car i) (cleanup (cdr i))))) + (vector->list (car p)))))]) + (syntax 'e)))]))) + + ;; Internal: + (define-syntax do-define-values/invoke-unit/sig + (lambda (stx) + (syntax-case stx () + [(_ global? signame unite prefix imports orig) + (let* ([formname (if (syntax-e (syntax global?)) + 'namespace-variable-bind/invoke-unit/sig + 'define-values/invoke-unit/sig)] + [badsyntax (lambda (s why) + (raise-syntax-error + #f + (format "bad syntax (~a)" why) + (syntax orig) + s))]) + (unless (or (not (syntax-e (syntax prefix))) + (identifier? (syntax prefix))) + (badsyntax (syntax prefix) "prefix is not an identifier")) + (let ([ex-sig (get-sig formname (syntax orig) #f (syntax signame) (syntax signame))]) + (let ([ex-exploded (explode-sig ex-sig #f)] + [ex-flattened (flatten-signature #f ex-sig #'signame)]) + (let ([im-sigs + (parse-invoke-vars formname (syntax imports) (syntax orig))]) + (let ([im-explodeds (explode-named-sigs im-sigs #f)] + [im-flattened (flatten-signatures im-sigs #f)] + [d->s (lambda (x) (datum->syntax-object (syntax orig) x (syntax orig)))]) + (with-syntax ([dv/iu (if (syntax-e (syntax global?)) + (quote-syntax namespace-variable-bind/invoke-unit) + (quote-syntax define-values/invoke-unit))] + [ex-flattened ex-flattened] + [ex-exploded (d->s ex-exploded)] + [im-explodeds (d->s im-explodeds)] + [im-flattened (d->s im-flattened)] + [formname formname] + [stx-decls (if (syntax-e (syntax global?)) + null + (make-struct-stx-decls ex-sig #f #f (syntax signame) #f))]) + (syntax/loc stx + (begin + (dv/iu + ex-flattened + (let ([unit-var unite]) + (alt-verify-linkage-signature-match + 'formname + '(invoke) + (list unit-var) + '(ex-exploded) + '(im-explodeds)) + (signed-unit-unit unit-var)) + prefix + . im-flattened) + . stx-decls))))))))]))) + + (define-syntax define-values/invoke-unit/sig + (lambda (stx) + (with-syntax ([orig stx]) + (syntax-case stx () + [(_ signame unit prefix . imports) + (syntax (do-define-values/invoke-unit/sig #f signame unit prefix imports orig))] + [(_ signame unit) + (syntax (do-define-values/invoke-unit/sig #f signame unit #f () orig))])))) + + (define-syntax namespace-variable-bind/invoke-unit/sig + (lambda (stx) + (with-syntax ([orig stx]) + (syntax-case stx () + [(_ signame unit prefix . imports) + (syntax (do-define-values/invoke-unit/sig #t signame unit prefix imports orig))] + [(_ signame unit) + (syntax (do-define-values/invoke-unit/sig #t signame unit #f () orig))])))) + + (define-syntax provide-signature-elements + (lambda (stx) + (with-syntax ([orig stx]) + (syntax-case stx () + [(_ signame) + (let ([sig (get-sig 'provide-signature-elements stx #f (syntax signame) (syntax signame))]) + (let ([flattened (flatten-signature #f sig (syntax signame))] + [structs (map struct-def-name (signature-structs sig))]) + (with-syntax ([flattened (map (lambda (x) (datum->syntax-object (syntax signame) x #f)) + (append flattened structs))]) + (syntax/loc stx + (provide . flattened)))))])))) + + (define (unit/sig? x) (signed-unit? x)) + (define (unit/sig->unit x) (signed-unit-unit x)) + + (provide define-signature + let-signature + unit/sig + compound-unit/sig + invoke-unit/sig + unit->unit/sig + signature->symbols + verify-signature-match + verify-linkage-signature-match + + (struct signed-unit (unit imports exports)) + unit/sig? unit/sig->unit + + define-values/invoke-unit/sig + namespace-variable-bind/invoke-unit/sig + provide-signature-elements)) diff --git a/collects/mzscheme/info.ss b/collects/mzscheme/info.ss index 5ec919c2d8..cd5848f535 100644 --- a/collects/mzscheme/info.ss +++ b/collects/mzscheme/info.ss @@ -1,4 +1,4 @@ (module info (lib "infotab.ss" "setup") (define name "MzScheme") - (define version '(300))) + (define version '(370))) diff --git a/collects/mztake/debug-tool.ss b/collects/mztake/debug-tool.ss index f09b08b618..af699406c3 100644 --- a/collects/mztake/debug-tool.ss +++ b/collects/mztake/debug-tool.ss @@ -4,7 +4,7 @@ (lib "string.ss") ;(lib "math.ss") (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "contract.ss") (lib "mred.ss" "mred") (prefix drscheme:arrow: (lib "arrow.ss" "drscheme")) @@ -28,9 +28,9 @@ ; how can the three tool classes communicate with each other safely (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define phase1 void) (define phase2 void) diff --git a/collects/mztake/marks.ss b/collects/mztake/marks.ss index 57c475985b..64b0ca0dad 100644 --- a/collects/mztake/marks.ss +++ b/collects/mztake/marks.ss @@ -86,8 +86,8 @@ ; : identifier -> identifier (define (make-mark-binding-stx id) #`(case-lambda - [() #,(syntax-property id 'stepper-dont-check-for-function #t)] - [(v) (set! #,(syntax-property id 'stepper-dont-check-for-function #t) v)])) + [() #,id] + [(v) (set! #,id v)])) (define (mark-bindings mark) (map list diff --git a/collects/net/base64-sig.ss b/collects/net/base64-sig.ss index 8440f8bbb1..242f953fca 100644 --- a/collects/net/base64-sig.ss +++ b/collects/net/base64-sig.ss @@ -1,13 +1,7 @@ - -(module base64-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:base64^) - - (define-signature net:base64^ - (base64-filename-safe - base64-encode-stream - base64-decode-stream - base64-encode - base64-decode))) +(module base64-sig (lib "a-signature.ss") + base64-filename-safe + base64-encode-stream + base64-decode-stream + base64-encode + base64-decode) diff --git a/collects/net/base64-unit.ss b/collects/net/base64-unit.ss index f410facdd2..730b9a0648 100644 --- a/collects/net/base64-unit.ss +++ b/collects/net/base64-unit.ss @@ -1,14 +1,8 @@ - - -(module base64-unit mzscheme - (require (lib "unitsig.ss")) - +(module base64-unit (lib "a-unit.ss") (require "base64-sig.ss") - (provide net:base64@) - (define net:base64@ - (unit/sig net:base64^ - (import) + (import) + (export base64^) (define base64-digit (make-vector 256)) (let loop ([n 0]) @@ -142,5 +136,5 @@ (let ([s (open-output-bytes)]) (base64-encode-stream (open-input-bytes src) s (bytes 13 10)) - (get-output-bytes s)))))) + (get-output-bytes s)))) diff --git a/collects/net/base64.ss b/collects/net/base64.ss index a1be0d6b85..28799dda22 100644 --- a/collects/net/base64.ss +++ b/collects/net/base64.ss @@ -1,12 +1,8 @@ - - (module base64 mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "base64-sig.ss" + "base64-unit.ss") - (require "base64-sig.ss") - (require "base64-unit.ss") + (define-values/invoke-unit/infer base64@) - (define-values/invoke-unit/sig net:base64^ - net:base64@) - - (provide-signature-elements net:base64^)) + (provide-signature-elements base64^)) diff --git a/collects/net/cgi-sig.ss b/collects/net/cgi-sig.ss index 8b88696ee3..61c95284c0 100644 --- a/collects/net/cgi-sig.ss +++ b/collects/net/cgi-sig.ss @@ -1,30 +1,23 @@ - -(module cgi-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:cgi^) - - (define-signature net:cgi^ - ( - ;; -- exceptions raised -- - (struct cgi-error ()) - (struct incomplete-%-suffix (chars)) - (struct invalid-%-suffix (char)) - - ;; -- cgi methods -- - get-bindings - get-bindings/post - get-bindings/get - output-http-headers - generate-html-output - generate-error-output - bindings-as-html - extract-bindings - extract-binding/single - get-cgi-method - - ;; -- general HTML utilities -- - string->html - generate-link-text - ))) +(module cgi-sig (lib "a-signature.ss") + ;; -- exceptions raised -- + (struct cgi-error ()) + (struct incomplete-%-suffix (chars)) + (struct invalid-%-suffix (char)) + + ;; -- cgi methods -- + get-bindings + get-bindings/post + get-bindings/get + output-http-headers + generate-html-output + generate-error-output + bindings-as-html + extract-bindings + extract-binding/single + get-cgi-method + + ;; -- general HTML utilities -- + string->html + generate-link-text + ) diff --git a/collects/net/cgi-unit.ss b/collects/net/cgi-unit.ss index e034e71240..58c7600248 100644 --- a/collects/net/cgi-unit.ss +++ b/collects/net/cgi-unit.ss @@ -1,10 +1,9 @@ -(module cgi-unit mzscheme - (require (lib "unitsig.ss") "cgi-sig.ss" (lib "etc.ss")) +(module cgi-unit (lib "a-unit.ss") + (require (lib "etc.ss") + "cgi-sig.ss") - (provide net:cgi@) - (define net:cgi@ - (unit/sig net:cgi^ - (import) + (import) + (export cgi^) ;; type bindings = list ((symbol . string)) @@ -239,5 +238,5 @@ (define (generate-link-text url anchor-text) (string-append "" anchor-text "")) - ))) + ) diff --git a/collects/net/cgi.ss b/collects/net/cgi.ss index 317331028c..21a9ae0502 100644 --- a/collects/net/cgi.ss +++ b/collects/net/cgi.ss @@ -1,11 +1,8 @@ - (module cgi mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "cgi-sig.ss" + "cgi-unit.ss") - (require "cgi-sig.ss") - (require "cgi-unit.ss") + (define-values/invoke-unit/infer cgi@) - (define-values/invoke-unit/sig net:cgi^ - net:cgi@) - - (provide-signature-elements net:cgi^)) + (provide-signature-elements cgi^)) diff --git a/collects/net/cookie-sig.ss b/collects/net/cookie-sig.ss index ef216c6c45..dc936019dc 100644 --- a/collects/net/cookie-sig.ss +++ b/collects/net/cookie-sig.ss @@ -1,19 +1,16 @@ -(module cookie-sig mzscheme - (require (lib "unitsig.ss")) - (provide net:cookie^) +(module cookie-sig (lib "a-signature.ss") - (define-signature net:cookie^ - (set-cookie - cookie:add-comment - cookie:add-domain - cookie:add-max-age - cookie:add-path - cookie:secure - cookie:version - ;; To actually return a cookie (string formated as a cookie): - print-cookie - ;; To parse the Cookies header: - get-cookie - get-cookie/single - ;; exceptions - (struct cookie-error ())))) + set-cookie + cookie:add-comment + cookie:add-domain + cookie:add-max-age + cookie:add-path + cookie:secure + cookie:version + ;; To actually return a cookie (string formated as a cookie): + print-cookie + ;; To parse the Cookies header: + get-cookie + get-cookie/single + ;; exceptions + (struct cookie-error ())) diff --git a/collects/net/cookie-unit.ss b/collects/net/cookie-unit.ss index 98f5d8ac5b..6f1f0591ed 100644 --- a/collects/net/cookie-unit.ss +++ b/collects/net/cookie-unit.ss @@ -47,304 +47,297 @@ ;; ;; You should think of this procedures as a `format' for cookies. -(module cookie-unit mzscheme - (require (lib "unitsig.ss") - (lib "etc.ss") +(module cookie-unit (lib "a-unit.ss") + (require (lib "etc.ss") (lib "list.ss") (lib "string.ss" "srfi" "13") (lib "char-set.ss" "srfi" "14") "cookie-sig.ss") - (provide cookie@) + (import) + (export cookie^) + + (define-struct cookie (name value comment domain max-age path secure version)) + (define-struct (cookie-error exn:fail) ()) + + ;; The syntax for the Set-Cookie response header is + ;; set-cookie = "Set-Cookie:" cookies + ;; cookies = 1#cookie + ;; cookie = NAME "=" VALUE *(";" cookie-av) + ;; NAME = attr + ;; VALUE = value + ;; cookie-av = "Comment" "=" value + ;; | "Domain" "=" value + ;; | "Max-Age" "=" value + ;; | "Path" "=" value + ;; | "Secure" + ;; | "Version" "=" 1*DIGIT + (define set-cookie + (lambda (name pre-value) + (let ([value (to-rfc2109:value pre-value)]) + (unless (rfc2068:token? name) + (raise (build-cookie-error (format "Invalid cookie name: ~a / ~a" name value)))) + (make-cookie name value + #f;; comment + #f;; current domain + #f;; at the end of session + #f;; current path + #f;; normal (non SSL) + #f;; default version + )))) + + ;;! + ;; + ;; (function (print-cookie cookie)) + ;; + ;; (param cookie Cookie-structure "The cookie to return as a string") + ;; + ;; Formats the cookie contents in a string ready to be appended to a + ;; "Set-Cookie: " header, and sent to a client (browser). + (define print-cookie + (lambda (cookie) + (unless (cookie? cookie) + (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) + (string-join + (filter (lambda (s) + (not (string-null? s))) + (list (format "~a=~a" (cookie-name cookie) (cookie-value cookie)) + (let ((c (cookie-comment cookie))) (if c (format "Comment=~a" c) "")) + (let ((d (cookie-domain cookie))) (if d (format "Domain=~a" d) "")) + (let ((age (cookie-max-age cookie))) (if age (format "Max-Age=~a" age) "")) + (let ((p (cookie-path cookie))) (if p (format "Path=~a" p) "")) + (let ((s (cookie-secure cookie))) (if s "Secure" "")) + (let ((v (cookie-version cookie))) (format "Version=~a" (if v v 1))))) + "; "))) + + (define cookie:add-comment + (lambda (cookie pre-comment) + (let ([comment (to-rfc2109:value pre-comment)]) + (unless (cookie? cookie) + (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) + (set-cookie-comment! cookie comment) + cookie))) + + (define cookie:add-domain + (lambda (cookie domain) + (unless (valid-domain? domain) + (raise (build-cookie-error (format "Invalid domain: ~a" domain)))) + (unless (cookie? cookie) + (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) + (set-cookie-domain! cookie domain) + cookie)) + + (define cookie:add-max-age + (lambda (cookie seconds) + (unless (and (integer? seconds) (not (negative? seconds))) + (raise (build-cookie-error (format "Invalid Max-Age for cookie: ~a" seconds)))) + (unless (cookie? cookie) + (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) + (set-cookie-max-age! cookie seconds) + cookie)) + + (define cookie:add-path + (lambda (cookie pre-path) + (let ([path (to-rfc2109:value pre-path)]) + (unless (cookie? cookie) + (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) + (set-cookie-path! cookie path) + cookie))) + + (define cookie:secure + (lambda (cookie secure?) + (unless (boolean? secure?) + (raise (build-cookie-error (format "Invalid argument (boolean expected), received: ~a" secure?)))) + (unless (cookie? cookie) + (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) + (set-cookie-secure! cookie secure?) + cookie)) + + (define cookie:version + (lambda (cookie version) + (unless (integer? version) + (raise (build-cookie-error (format "Unsupported version: ~a" version)))) + (unless (cookie? cookie) + (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) + (set-cookie-version! cookie version) + cookie)) - (define cookie@ - (unit/sig net:cookie^ - (import) - - (define-struct cookie (name value comment domain max-age path secure version)) - (define-struct (cookie-error exn:fail) ()) - - ;; The syntax for the Set-Cookie response header is - ;; set-cookie = "Set-Cookie:" cookies - ;; cookies = 1#cookie - ;; cookie = NAME "=" VALUE *(";" cookie-av) - ;; NAME = attr - ;; VALUE = value - ;; cookie-av = "Comment" "=" value - ;; | "Domain" "=" value - ;; | "Max-Age" "=" value - ;; | "Path" "=" value - ;; | "Secure" - ;; | "Version" "=" 1*DIGIT - (define set-cookie - (lambda (name pre-value) - (let ([value (to-rfc2109:value pre-value)]) - (unless (rfc2068:token? name) - (raise (build-cookie-error (format "Invalid cookie name: ~a / ~a" name value)))) - (make-cookie name value - #f;; comment - #f;; current domain - #f;; at the end of session - #f;; current path - #f;; normal (non SSL) - #f;; default version - )))) + ;; Parsing the Cookie header: - ;;! - ;; - ;; (function (print-cookie cookie)) - ;; - ;; (param cookie Cookie-structure "The cookie to return as a string") - ;; - ;; Formats the cookie contents in a string ready to be appended to a - ;; "Set-Cookie: " header, and sent to a client (browser). - (define print-cookie - (lambda (cookie) - (unless (cookie? cookie) - (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) - (string-join - (filter (lambda (s) - (not (string-null? s))) - (list (format "~a=~a" (cookie-name cookie) (cookie-value cookie)) - (let ((c (cookie-comment cookie))) (if c (format "Comment=~a" c) "")) - (let ((d (cookie-domain cookie))) (if d (format "Domain=~a" d) "")) - (let ((age (cookie-max-age cookie))) (if age (format "Max-Age=~a" age) "")) - (let ((p (cookie-path cookie))) (if p (format "Path=~a" p) "")) - (let ((s (cookie-secure cookie))) (if s "Secure" "")) - (let ((v (cookie-version cookie))) (format "Version=~a" (if v v 1))))) - "; "))) + (define char-set:all-but= + (char-set-difference char-set:full (string->char-set "="))) - (define cookie:add-comment - (lambda (cookie pre-comment) - (let ([comment (to-rfc2109:value pre-comment)]) - (unless (cookie? cookie) - (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) - (set-cookie-comment! cookie comment) - cookie))) + (define char-set:all-but-semicolon + (char-set-difference char-set:full (string->char-set ";"))) - (define cookie:add-domain - (lambda (cookie domain) - (unless (valid-domain? domain) - (raise (build-cookie-error (format "Invalid domain: ~a" domain)))) - (unless (cookie? cookie) - (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) - (set-cookie-domain! cookie domain) - cookie)) + ;;! + ;; + ;; (function (get-all-results name cookies)) + ;; + ;; Auxiliar procedure that returns all values associated with + ;; `name' in the association list (cookies). + (define get-all-results + (lambda (name cookies) + (let loop ((c cookies)) + (cond ((null? c) ()) + (else + (let ((pair (car c))) + (if (string=? name (car pair)) + ;; found an instance of cookie named `name' + (cons (cadr pair) (loop (cdr c))) + (loop (cdr c))))))))) - (define cookie:add-max-age - (lambda (cookie seconds) - (unless (and (integer? seconds) (not (negative? seconds))) - (raise (build-cookie-error (format "Invalid Max-Age for cookie: ~a" seconds)))) - (unless (cookie? cookie) - (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) - (set-cookie-max-age! cookie seconds) - cookie)) + ;; which tipically looks like: (cookie . "test5=\"5\"; test1=\"1\"; test0=\"0\"; test1=\"20\"") + ;; note that it can be multi-valued: `test1' has values: "1", and "20". + ;; Of course, in the same spirit, we only receive the "string content". + (define get-cookie + (lambda (name cookies) + (let ((cookies (map (lambda (p) + (map string-trim-both + (string-tokenize p char-set:all-but=))) + (string-tokenize cookies char-set:all-but-semicolon)))) + (get-all-results name cookies)))) - (define cookie:add-path - (lambda (cookie pre-path) - (let ([path (to-rfc2109:value pre-path)]) - (unless (cookie? cookie) - (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) - (set-cookie-path! cookie path) - cookie))) - - (define cookie:secure - (lambda (cookie secure?) - (unless (boolean? secure?) - (raise (build-cookie-error (format "Invalid argument (boolean expected), received: ~a" secure?)))) - (unless (cookie? cookie) - (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) - (set-cookie-secure! cookie secure?) - cookie)) - - (define cookie:version - (lambda (cookie version) - (unless (integer? version) - (raise (build-cookie-error (format "Unsupported version: ~a" version)))) - (unless (cookie? cookie) - (raise (build-cookie-error (format "Cookie expected, received: ~a" cookie)))) - (set-cookie-version! cookie version) - cookie)) + ;;! + ;; + ;; (function (get-cookie/single name cookies)) + ;; + ;; (param name String "The name of the cookie we are looking for") + ;; (param cookies String "The string (from the environment) with the content of the cookie header.") + ;; + ;; Returns the first name associated with the cookie named `name', if any, or #f. + (define get-cookie/single + (lambda (name cookies) + (let ((cookies (get-cookie name cookies))) + (and (not (null? cookies)) + (car cookies))))) - ;; Parsing the Cookie header: + ;;;;; + ;; Auxiliary procedures + ;;;;; + ;; token = 1* + ;; + ;; tspecials = "(" | ")" | "<" | ">" | "@" + ;; | "," | ";" | ":" | "\" | <"> + ;; | "/" | "[" | "]" | "?" | "=" + ;; | "{" | "}" | SP | HT + (define char-set:tspecials + (char-set-union (string->char-set "()<>@,;:\\\"/[]?={}") + char-set:whitespace + (char-set #\tab))) - (define char-set:all-but= - (char-set-difference char-set:full (string->char-set "="))) + (define char-set:control + (char-set-union char-set:iso-control + (char-set (integer->char 127))));; DEL + (define char-set:token (char-set-difference char-set:ascii char-set:tspecials char-set:control)) - (define char-set:all-but-semicolon - (char-set-difference char-set:full (string->char-set ";"))) + ;; token? : string -> boolean + ;; + ;; returns #t if s is an RFC 2068 token (see definition above), #f otherwise. + (define rfc2068:token? + (lambda (s) (string-every char-set:token s))) - ;;! - ;; - ;; (function (get-all-results name cookies)) - ;; - ;; Auxiliar procedure that returns all values associated with - ;; `name' in the association list (cookies). - (define get-all-results - (lambda (name cookies) - (let loop ((c cookies)) - (cond ((null? c) ()) - (else - (let ((pair (car c))) - (if (string=? name (car pair)) - ;; found an instance of cookie named `name' - (cons (cadr pair) (loop (cdr c))) - (loop (cdr c))))))))) - - ;; which tipically looks like: (cookie . "test5=\"5\"; test1=\"1\"; test0=\"0\"; test1=\"20\"") - ;; note that it can be multi-valued: `test1' has values: "1", and "20". - ;; Of course, in the same spirit, we only receive the "string content". - (define get-cookie - (lambda (name cookies) - (let ((cookies (map (lambda (p) - (map string-trim-both - (string-tokenize p char-set:all-but=))) - (string-tokenize cookies char-set:all-but-semicolon)))) - (get-all-results name cookies)))) + ;;! + ;; + ;; (function (quoted-string? s)) + ;; + ;; (param s String "The string to check") + ;; + ;; Returns s if the string is an RFC 2068 quoted-string, #f otherwise. As in: + ;; quoted-string = ( <"> *(qdtext) <"> ) + ;; qdtext = > + ;; + ;; The backslash character ("\") may be used as a single-character quoting + ;; mechanism only within quoted-string and comment constructs. + ;; + ;; quoted-pair = "\" CHAR + ;; + ;; implementation note: I have chosen to use a regular expression rather than + ;; a character set for this definition because of two dependencies: CRLF must appear + ;; as a block to be legal, and " may only appear as \" + (define rfc2068:quoted-string? + (lambda (s) + (if (regexp-match #rx"^\"([^\"#\u0000-#\u001F]| |#\return#\newline|#\tab|\\\\\")*\"$" s) + s + #f))) - ;;! - ;; - ;; (function (get-cookie/single name cookies)) - ;; - ;; (param name String "The name of the cookie we are looking for") - ;; (param cookies String "The string (from the environment) with the content of the cookie header.") - ;; - ;; Returns the first name associated with the cookie named `name', if any, or #f. - (define get-cookie/single - (lambda (name cookies) - (let ((cookies (get-cookie name cookies))) - (and (not (null? cookies)) - (car cookies))))) + ;; value: token | quoted-string + (define (rfc2109:value? s) + (or (rfc2068:token? s) (rfc2068:quoted-string? s))) - - - ;;;;; - ;; Auxiliar procedures - ;;;;; - + ;; convert-to-quoted : string -> quoted-string? + ;; takes the given string as a particular message, and converts the given string to that + ;; representatation + (define (convert-to-quoted str) + (string-append "\"" (regexp-replace* #rx"\"" str "\\\\\"") "\"")) - ;; token = 1* - ;; - ;; tspecials = "(" | ")" | "<" | ">" | "@" - ;; | "," | ";" | ":" | "\" | <"> - ;; | "/" | "[" | "]" | "?" | "=" - ;; | "{" | "}" | SP | HT - (define char-set:tspecials - (char-set-union - (string->char-set "()<>@,;:\\\"/[]?={}") - char-set:whitespace - (char-set #\tab))) - - (define char-set:control (char-set-union char-set:iso-control - (char-set (integer->char 127))));; DEL - (define char-set:token (char-set-difference char-set:ascii char-set:tspecials char-set:control)) - - ;; token? : string -> boolean - ;; - ;; returns #t if s is an RFC 2068 token (see definition above), #f otherwise. - (define rfc2068:token? - (lambda (s) (string-every char-set:token s))) - - ;;! - ;; - ;; (function (quoted-string? s)) - ;; - ;; (param s String "The string to check") - ;; - ;; Returns s if the string is an RFC 2068 quoted-string, #f otherwise. As in: - ;; quoted-string = ( <"> *(qdtext) <"> ) - ;; qdtext = > - ;; - ;; The backslash character ("\") may be used as a single-character quoting - ;; mechanism only within quoted-string and comment constructs. - ;; - ;; quoted-pair = "\" CHAR - ;; - ;; implementation note: I have chosen to use a regular expression rather than - ;; a character set for this definition because of two dependencies: CRLF must appear - ;; as a block to be legal, and " may only appear as \" - (define rfc2068:quoted-string? - (lambda (s) - (if (regexp-match #rx"^\"([^\"#\u0000-#\u001F]| |#\return#\newline|#\tab|\\\\\")*\"$" s) - s - #f))) - - ;; value: token | quoted-string - (define (rfc2109:value? s) - (or (rfc2068:token? s) (rfc2068:quoted-string? s))) - - ;; convert-to-quoted : string -> quoted-string? - ;; takes the given string as a particular message, and converts the given string to that - ;; representatation - (define (convert-to-quoted str) - (string-append "\"" (regexp-replace* #rx"\"" str "\\\\\"") "\"")) - - ;; string -> rfc2109:value? - (define (to-rfc2109:value s) - (cond - [(not (string? s)) - (raise (build-cookie-error (format "Expected string, given: ~e" s)))] - - ; for backwards compatibility, just use the given string if it will work - [(rfc2068:token? s) s] - [(rfc2068:quoted-string? s) s] - - ; ... but if it doesn't work (i.e., it's just a normal message) then try to - ; convert it into a representation that will work - [(rfc2068:quoted-string? (convert-to-quoted s)) - => (λ (x) x)] - [else - (raise - (build-cookie-error - (format "Could not convert the given string to an acceptable RFC 2109 value: ~s" s)))])) - - - ;;! - ;; - ;; (function (cookie-string? s)) - ;; - ;; (param s String "String to check") - ;; - ;; Returns whether this is a valid string to use as the value or the - ;; name (depending on value?) of an HTTP cookie. - (define cookie-string? - (opt-lambda (s (value? #t)) - (unless (string? s) - (raise (build-cookie-error (format "String expected, received: ~a" s)))) - (if value? - (rfc2109:value? s) - ;; name: token - (rfc2068:token? s)))) + ;; string -> rfc2109:value? + (define (to-rfc2109:value s) + (cond + [(not (string? s)) + (raise (build-cookie-error (format "Expected string, given: ~e" s)))] + + ;; for backwards compatibility, just use the given string if it will work + [(rfc2068:token? s) s] + [(rfc2068:quoted-string? s) s] + + ;; ... but if it doesn't work (i.e., it's just a normal message) then try + ;; to convert it into a representation that will work + [(rfc2068:quoted-string? (convert-to-quoted s)) + => (λ (x) x)] + [else + (raise + (build-cookie-error + (format "Could not convert the given string to an acceptable RFC 2109 value: ~s" s)))])) + + ;;! + ;; + ;; (function (cookie-string? s)) + ;; + ;; (param s String "String to check") + ;; + ;; Returns whether this is a valid string to use as the value or the + ;; name (depending on value?) of an HTTP cookie. + (define cookie-string? + (opt-lambda (s (value? #t)) + (unless (string? s) + (raise (build-cookie-error (format "String expected, received: ~a" s)))) + (if value? + (rfc2109:value? s) + ;; name: token + (rfc2068:token? s)))) + + ;; Host names as per RFC 1123 and RFC952, more or less, anyway. :-) + (define char-set:hostname + (let ((a-z-lowercase (ucs-range->char-set #x61 #x7B)) + (a-z-uppercase (ucs-range->char-set #x41 #x5B))) + (char-set-adjoin! + (char-set-union char-set:digit a-z-lowercase a-z-uppercase) + #\. ))) + + (define valid-domain? + (lambda (dom) + (and + ;; Domain must start with a dot (.) + (string=? (string-take dom 1) ".") + ;; The rest are tokens-like strings separated by dots + (string-every char-set:hostname dom) + (<= (string-length dom) 76)))) + + (define (valid-path? v) + (and (string? v) + (rfc2109:value? v))) + + ;; build-cookie-error : string -> cookie-error + ;; constructs a cookie-error struct from the given error message + ;; (added to fix exceptions-must-take-immutable-strings bug) + (define (build-cookie-error msg) + (make-cookie-error (string->immutable-string msg) + (current-continuation-marks))) - ;; Host names as per RFC 1123 and RFC952, more or less, anyway. :-) - (define char-set:hostname - (let ((a-z-lowercase (ucs-range->char-set #x61 #x7B)) - (a-z-uppercase (ucs-range->char-set #x41 #x5B))) - (char-set-adjoin! - (char-set-union char-set:digit a-z-lowercase a-z-uppercase) - #\. ))) - - (define valid-domain? - (lambda (dom) - (and - ;; Domain must start with a dot (.) - (string=? (string-take dom 1) ".") - ;; The rest are tokens-like strings separated by dots - (string-every char-set:hostname dom) - (<= (string-length dom) 76)))) - - (define (valid-path? v) - (and (string? v) - (rfc2109:value? v))) - - ;; build-cookie-error : string -> cookie-error - ;; constructs a cookie-error struct from the given error message - ;; (added to fix exceptions-must-take-immutable-strings bug) - (define (build-cookie-error msg) - (make-cookie-error (string->immutable-string msg) (current-continuation-marks))))) ) -;;; cookie-unit.ss ends here \ No newline at end of file +;;; cookie-unit.ss ends here diff --git a/collects/net/cookie.ss b/collects/net/cookie.ss index b9f4ceeafc..146b158521 100644 --- a/collects/net/cookie.ss +++ b/collects/net/cookie.ss @@ -1,9 +1,8 @@ (module cookie mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") "cookie-sig.ss" "cookie-unit.ss") - (provide-signature-elements net:cookie^) + (provide-signature-elements cookie^) - (define-values/invoke-unit/sig net:cookie^ - cookie@)) \ No newline at end of file + (define-values/invoke-unit/infer cookie@)) \ No newline at end of file diff --git a/collects/net/dns-sig.ss b/collects/net/dns-sig.ss index 020f460bc1..02407eb425 100644 --- a/collects/net/dns-sig.ss +++ b/collects/net/dns-sig.ss @@ -1,12 +1,6 @@ - -(module dns-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:dns^) - - (define-signature net:dns^ - (dns-get-address - dns-get-name - dns-get-mail-exchanger - dns-find-nameserver))) +(module dns-sig (lib "a-signature.ss") + dns-get-address + dns-get-name + dns-get-mail-exchanger + dns-find-nameserver) diff --git a/collects/net/dns-unit.ss b/collects/net/dns-unit.ss index 4f15164e90..7ff976022d 100644 --- a/collects/net/dns-unit.ss +++ b/collects/net/dns-unit.ss @@ -1,18 +1,14 @@ +(module dns-unit (lib "a-unit.ss") + (require (lib "list.ss") + (lib "process.ss") + "dns-sig.ss") -(module dns-unit mzscheme - (require (lib "unitsig.ss") - (lib "list.ss") - (lib "process.ss")) - (require "dns-sig.ss") + (import) + (export dns^) - ;; UDP retry timeout: - (define INIT-TIMEOUT 50) - - (provide net:dns@) - (define net:dns@ - (unit/sig net:dns^ - (import) + ;; UDP retry timeout: + (define INIT-TIMEOUT 50) (define types '((a 1) @@ -365,5 +361,5 @@ line)) => (lambda (m) (loop name (cadr m) #f))] [else (loop name ip #f)]))))))] - [else #f]))))) + [else #f]))) diff --git a/collects/net/dns.ss b/collects/net/dns.ss index 44ad9cda6c..773702596f 100644 --- a/collects/net/dns.ss +++ b/collects/net/dns.ss @@ -1,11 +1,8 @@ - (module dns mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "dns-sig.ss" + "dns-unit.ss") - (require "dns-sig.ss") - (require "dns-unit.ss") + (define-values/invoke-unit/infer dns@) - (define-values/invoke-unit/sig net:dns^ - net:dns@) - - (provide-signature-elements net:dns^)) + (provide-signature-elements dns^)) diff --git a/collects/net/ftp-sig.ss b/collects/net/ftp-sig.ss index 3de7fdc083..2d2712cd7b 100644 --- a/collects/net/ftp-sig.ss +++ b/collects/net/ftp-sig.ss @@ -1,13 +1,8 @@ -(module ftp-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:ftp^) - - (define-signature net:ftp^ - (ftp-cd - ftp-establish-connection ftp-establish-connection* - ftp-close-connection - ftp-directory-list - ftp-download-file - ftp-make-file-seconds))) +(module ftp-sig (lib "a-signature.ss") + ftp-cd + ftp-establish-connection ftp-establish-connection* + ftp-close-connection + ftp-directory-list + ftp-download-file + ftp-make-file-seconds) diff --git a/collects/net/ftp-unit.ss b/collects/net/ftp-unit.ss index 4e3723bd14..3c0c5b3399 100644 --- a/collects/net/ftp-unit.ss +++ b/collects/net/ftp-unit.ss @@ -1,4 +1,4 @@ -(module ftp-unit mzscheme +(module ftp-unit (lib "a-unit.ss") ;; Version 0.2 ;; Version 0.1a ;; Micah Flatt @@ -6,13 +6,9 @@ (require (lib "date.ss") (lib "file.ss") (lib "port.ss") - "ftp-sig.ss" - (lib "unitsig.ss")) - - (provide net:ftp@) - (define net:ftp@ - (unit/sig net:ftp^ - (import) + "ftp-sig.ss") + (import) + (export ftp^) ;; opqaue record to represent an FTP connection: (define-struct tcp-connection (in out)) @@ -216,4 +212,4 @@ (rename-file-or-directory tmpfile (build-path folder filename) #t))) ;; (printf "FTP Client Installed...~n") - ))) + ) diff --git a/collects/net/ftp.ss b/collects/net/ftp.ss index 4fbe7ff0a1..89d451eb30 100644 --- a/collects/net/ftp.ss +++ b/collects/net/ftp.ss @@ -1,11 +1,8 @@ - (module ftp mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "ftp-sig.ss" + "ftp-unit.ss") - (require "ftp-sig.ss") - (require "ftp-unit.ss") + (define-values/invoke-unit/infer ftp@) - (define-values/invoke-unit/sig net:ftp^ - net:ftp@) - - (provide-signature-elements net:ftp^)) + (provide-signature-elements ftp^)) diff --git a/collects/net/head-sig.ss b/collects/net/head-sig.ss index d32cae1beb..631802a99d 100644 --- a/collects/net/head-sig.ss +++ b/collects/net/head-sig.ss @@ -1,19 +1,14 @@ - -(module head-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:head^) - (define-signature net:head^ - (empty-header - validate-header - extract-field - remove-field - insert-field - replace-field - extract-all-fields - append-headers - standard-message-header - data-lines->data - extract-addresses - assemble-address-field))) +(module head-sig (lib "a-signature.ss") + empty-header + validate-header + extract-field + remove-field + insert-field + replace-field + extract-all-fields + append-headers + standard-message-header + data-lines->data + extract-addresses + assemble-address-field) diff --git a/collects/net/head-unit.ss b/collects/net/head-unit.ss index 5adb90e40a..93644fd121 100644 --- a/collects/net/head-unit.ss +++ b/collects/net/head-unit.ss @@ -1,16 +1,11 @@ +(module head-unit (lib "a-unit.ss") + (require (lib "date.ss") + (lib "string.ss") + "head-sig.ss") -(module head-unit mzscheme - (require (lib "unitsig.ss") - (lib "date.ss") - (lib "string.ss")) + (import) + (export head^) - (require "head-sig.ss") - - (provide net:head@) - (define net:head@ - (unit/sig net:head^ - (import) - ;; NB: I've done a copied-code adaptation of a number of these definitions into ;; "bytes-compatible" versions. Finishing the rest will require some kind of interface ;; decision---that is, when you don't supply a header, should the resulting operation @@ -402,4 +397,4 @@ alen) (loop (cdr addresses) (format "~a, ~a" s addr) - (+ len alen 2))))))))))) + (+ len alen 2))))))))) diff --git a/collects/net/head.ss b/collects/net/head.ss index 10249f5ed5..e4b0169a6a 100644 --- a/collects/net/head.ss +++ b/collects/net/head.ss @@ -1,11 +1,8 @@ - (module head mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "head-sig.ss" + "head-unit.ss") - (require "head-sig.ss") - (require "head-unit.ss") + (define-values/invoke-unit/infer head@) - (define-values/invoke-unit/sig net:head^ - net:head@) - - (provide-signature-elements net:head^)) + (provide-signature-elements head^)) diff --git a/collects/net/imap-sig.ss b/collects/net/imap-sig.ss index 44d8dda237..df074c01a1 100644 --- a/collects/net/imap-sig.ss +++ b/collects/net/imap-sig.ss @@ -1,44 +1,38 @@ - - -(module imap-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:imap^) - (define-signature net:imap^ - (imap-port-number - imap-connection? - - imap-connect imap-connect* - imap-disconnect - imap-force-disconnect - imap-reselect - imap-examine - imap-noop - imap-status - imap-poll - - imap-new? - imap-messages - imap-recent - imap-uidnext - imap-uidvalidity - imap-unseen - imap-reset-new! - - imap-get-expunges - imap-pending-expunges? - imap-get-updates - imap-pending-updates? - - imap-get-messages - imap-copy imap-append - imap-store imap-flag->symbol symbol->imap-flag - imap-expunge - - imap-mailbox-exists? - imap-create-mailbox - - imap-list-child-mailboxes - imap-mailbox-flags - imap-get-hierarchy-delimiter))) +(module imap-sig (lib "a-signature.ss") + imap-port-number + imap-connection? + + imap-connect imap-connect* + imap-disconnect + imap-force-disconnect + imap-reselect + imap-examine + imap-noop + imap-status + imap-poll + + imap-new? + imap-messages + imap-recent + imap-uidnext + imap-uidvalidity + imap-unseen + imap-reset-new! + + imap-get-expunges + imap-pending-expunges? + imap-get-updates + imap-pending-updates? + + imap-get-messages + imap-copy imap-append + imap-store imap-flag->symbol symbol->imap-flag + imap-expunge + + imap-mailbox-exists? + imap-create-mailbox + + imap-list-child-mailboxes + imap-mailbox-flags + imap-get-hierarchy-delimiter) diff --git a/collects/net/imap-unit.ss b/collects/net/imap-unit.ss index a6c6978467..c30b76c719 100644 --- a/collects/net/imap-unit.ss +++ b/collects/net/imap-unit.ss @@ -1,14 +1,10 @@ - -(module imap-unit mzscheme - (require (lib "unitsig.ss") - (lib "list.ss") +(module imap-unit (lib "a-unit.ss") + (require (lib "list.ss") "imap-sig.ss" "private/rbtree.ss") - (provide net:imap@) - (define net:imap@ - (unit/sig net:imap^ - (import) + (import) + (export imap^) (define debug-via-stdio? #f) @@ -572,4 +568,4 @@ (cons (list flags name) sub-folders)))))))) - (reverse sub-folders)))))) + (reverse sub-folders)))) diff --git a/collects/net/imap.ss b/collects/net/imap.ss index b7560362c7..9483e1ce70 100644 --- a/collects/net/imap.ss +++ b/collects/net/imap.ss @@ -1,13 +1,10 @@ - (module imap mzscheme - (require (lib "unitsig.ss") - (lib "contract.ss")) - - (require "imap-sig.ss" + (require (lib "unit.ss") + (lib "contract.ss") + "imap-sig.ss" "imap-unit.ss") - (define-values/invoke-unit/sig net:imap^ - net:imap@) + (define-values/invoke-unit/infer imap@) (provide/contract [imap-get-hierarchy-delimiter (imap-connection? . -> . bytes?)] diff --git a/collects/net/mime-sig.ss b/collects/net/mime-sig.ss index 6983623876..99383d212f 100644 --- a/collects/net/mime-sig.ss +++ b/collects/net/mime-sig.ss @@ -1,33 +1,26 @@ -(module mime-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:mime^) +(module mime-sig (lib "a-signature.ss") + ;; -- exceptions raised -- + (struct mime-error () -setters -constructor) + (struct unexpected-termination (msg) -setters -constructor) + (struct missing-multipart-boundary-parameter () -setters -constructor) + (struct malformed-multipart-entity (msg) -setters -constructor) + (struct empty-mechanism () -setters -constructor) + (struct empty-type () -setters -constructor) + (struct empty-subtype () -setters -constructor) + (struct empty-disposition-type () -setters -constructor) - (define-signature net:mime^ - ( - ;; -- exceptions raised -- - (struct mime-error () -setters (- make-mime-error)) - (struct unexpected-termination (msg) -setters (- make-unexpected-termination)) - (struct missing-multipart-boundary-parameter () -setters - (- make-missing-multipart-boundary-parameter)) - (struct malformed-multipart-entity (msg) -setters (- make-malformed-multipart-entity)) - (struct empty-mechanism () -setters (- make-empty-mechanism)) - (struct empty-type () -setters (- make-empty-type)) - (struct empty-subtype () -setters (- make-empty-subtype)) - (struct empty-disposition-type () -setters (- make-empty-disposition-type)) - - ;; -- basic mime structures -- - (struct message (version entity fields)) - (struct entity - (type subtype charset encoding - disposition params id - description other fields - parts body)) - (struct disposition - (type filename creation - modification read - size params)) - - ;; -- mime methods -- - mime-analyze - ))) + ;; -- basic mime structures -- + (struct message (version entity fields)) + (struct entity + (type subtype charset encoding + disposition params id + description other fields + parts body)) + (struct disposition + (type filename creation + modification read + size params)) + + ;; -- mime methods -- + mime-analyze + ) diff --git a/collects/net/mime-unit.ss b/collects/net/mime-unit.ss index 8abeec0e0c..f0e2d1940d 100644 --- a/collects/net/mime-unit.ss +++ b/collects/net/mime-unit.ss @@ -27,23 +27,18 @@ ;; Commentary: MIME support for PLT Scheme: an implementation of ;; rfc2045, rfc2046, rfc2047, rfc2048, and rfc2049. -(module mime-unit mzscheme +(module mime-unit (lib "a-unit.ss") (require "mime-sig.ss" "qp-sig.ss" "base64-sig.ss" "head-sig.ss" "mime-util.ss" - (lib "unitsig.ss") (lib "etc.ss") (lib "string.ss") (lib "port.ss")) - (provide net:mime@) - (define net:mime@ - (unit/sig net:mime^ - (import net:base64^ - net:qp^ - net:head^) + (import base64^ qp^ head^) + (export mime^) ;; Constants: (define discrete-alist '(("text" . text) @@ -783,4 +778,4 @@ (define disp-quoted-data-time date-time) - ))) + ) diff --git a/collects/net/mime.ss b/collects/net/mime.ss index aa58c2b24b..939d22fc5e 100644 --- a/collects/net/mime.ss +++ b/collects/net/mime.ss @@ -27,9 +27,8 @@ ;; Commentary: (module mime mzscheme - (require (lib "unitsig.ss")) - - (require "mime-sig.ss" + (require (lib "unit.ss") + "mime-sig.ss" "mime-unit.ss" "qp-sig.ss" "qp.ss" @@ -38,11 +37,15 @@ "head-sig.ss" "head.ss") - (define-values/invoke-unit/sig net:mime^ - net:mime@ - #f - net:base64^ net:qp^ net:head^) + (define-unit-from-context base64@ base64^) + (define-unit-from-context qp@ qp^) + (define-unit-from-context head@ head^) - (provide-signature-elements net:mime^)) + (define-compound-unit/infer mime@2 (import) (export mime^) + (link base64@ qp@ head@ mime@)) + + (define-values/invoke-unit/infer mime@2) + + (provide-signature-elements mime^)) ;;; mime.ss ends here \ No newline at end of file diff --git a/collects/net/nntp-sig.ss b/collects/net/nntp-sig.ss index 2fd7e4d470..d08d200aaa 100644 --- a/collects/net/nntp-sig.ss +++ b/collects/net/nntp-sig.ss @@ -1,26 +1,20 @@ - -(module nntp-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:nntp^) +(module nntp-sig (lib "a-signature.ss") + (struct communicator (sender receiver server port)) + connect-to-server connect-to-server* disconnect-from-server + authenticate-user open-news-group + head-of-message body-of-message + newnews-since generic-message-command + make-desired-header extract-desired-headers - (define-signature net:nntp^ - ((struct communicator (sender receiver server port)) - connect-to-server connect-to-server* disconnect-from-server - authenticate-user open-news-group - head-of-message body-of-message - newnews-since generic-message-command - make-desired-header extract-desired-headers - - (struct nntp ()) - (struct unexpected-response (code text)) - (struct bad-status-line (line)) - (struct premature-close (communicator)) - (struct bad-newsgroup-line (line)) - (struct non-existent-group (group)) - (struct article-not-in-group (article)) - (struct no-group-selected ()) - (struct article-not-found (article)) - (struct authentication-rejected ())))) + (struct nntp ()) + (struct unexpected-response (code text)) + (struct bad-status-line (line)) + (struct premature-close (communicator)) + (struct bad-newsgroup-line (line)) + (struct non-existent-group (group)) + (struct article-not-in-group (article)) + (struct no-group-selected ()) + (struct article-not-found (article)) + (struct authentication-rejected ())) diff --git a/collects/net/nntp-unit.ss b/collects/net/nntp-unit.ss index f5aa600416..ae306d104c 100644 --- a/collects/net/nntp-unit.ss +++ b/collects/net/nntp-unit.ss @@ -1,13 +1,9 @@ -(module nntp-unit mzscheme - (require (lib "unitsig.ss") - (lib "etc.ss")) +(module nntp-unit (lib "a-unit.ss") + (require (lib "etc.ss") + "nntp-sig.ss") - (require "nntp-sig.ss") - - (provide net:nntp@) - (define net:nntp@ - (unit/sig net:nntp^ - (import) + (import) + (export nntp^) ;; sender : oport ;; receiver : iport @@ -337,5 +333,5 @@ (regexp-match matcher first)) desireds) (cons first (loop rest)) - (loop rest)))))))))) + (loop rest)))))))) diff --git a/collects/net/nntp.ss b/collects/net/nntp.ss index 57b2b25c4d..4fca3dd120 100644 --- a/collects/net/nntp.ss +++ b/collects/net/nntp.ss @@ -1,11 +1,8 @@ - (module nntp mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "nntp-sig.ss" + "nntp-unit.ss") - (require "nntp-sig.ss") - (require "nntp-unit.ss") + (define-values/invoke-unit/infer nntp@) - (define-values/invoke-unit/sig net:nntp^ - net:nntp@) - - (provide-signature-elements net:nntp^)) + (provide-signature-elements nntp^)) diff --git a/collects/net/pop3-sig.ss b/collects/net/pop3-sig.ss index 3b0db30662..67cf18de4f 100644 --- a/collects/net/pop3-sig.ss +++ b/collects/net/pop3-sig.ss @@ -1,27 +1,21 @@ - -(module pop3-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:pop3^) +(module pop3-sig (lib "a-signature.ss") + (struct communicator (sender receiver server port state)) + connect-to-server connect-to-server* disconnect-from-server + authenticate/plain-text + get-mailbox-status + get-message/complete get-message/headers get-message/body + delete-message + get-unique-id/single get-unique-id/all - (define-signature net:pop3^ - ((struct communicator (sender receiver server port state)) - connect-to-server connect-to-server* disconnect-from-server - authenticate/plain-text - get-mailbox-status - get-message/complete get-message/headers get-message/body - delete-message - get-unique-id/single get-unique-id/all - - make-desired-header extract-desired-headers - - (struct pop3 ()) - (struct cannot-connect ()) - (struct username-rejected ()) - (struct password-rejected ()) - (struct not-ready-for-transaction (communicator)) - (struct not-given-headers (communicator message)) - (struct illegal-message-number (communicator message)) - (struct cannot-delete-message (communicator message)) - (struct disconnect-not-quiet (communicator)) - (struct malformed-server-response (communicator))))) + make-desired-header extract-desired-headers + + (struct pop3 ()) + (struct cannot-connect ()) + (struct username-rejected ()) + (struct password-rejected ()) + (struct not-ready-for-transaction (communicator)) + (struct not-given-headers (communicator message)) + (struct illegal-message-number (communicator message)) + (struct cannot-delete-message (communicator message)) + (struct disconnect-not-quiet (communicator)) + (struct malformed-server-response (communicator))) diff --git a/collects/net/pop3-unit.ss b/collects/net/pop3-unit.ss index 46ed8064a3..e9c2717d46 100644 --- a/collects/net/pop3-unit.ss +++ b/collects/net/pop3-unit.ss @@ -1,14 +1,9 @@ +(module pop3-unit (lib "a-unit.ss") + (require (lib "etc.ss") + "pop3-sig.ss") -(module pop3-unit mzscheme - (require (lib "unitsig.ss") - (lib "etc.ss")) - - (require "pop3-sig.ss") - - (provide net:pop3@) - (define net:pop3@ - (unit/sig net:pop3^ - (import) + (import) + (export pop3^) ;; Implements RFC 1939, Post Office Protocol - Version 3, Myers & Rose @@ -411,5 +406,5 @@ (regexp-match matcher first)) desireds) (cons first (loop rest)) - (loop rest)))))))))) + (loop rest)))))))) diff --git a/collects/net/pop3.ss b/collects/net/pop3.ss index e625094901..86b8d8e7b3 100644 --- a/collects/net/pop3.ss +++ b/collects/net/pop3.ss @@ -1,14 +1,11 @@ - (module pop3 mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "pop3-sig.ss" + "pop3-unit.ss") - (require "pop3-sig.ss") - (require "pop3-unit.ss") + (define-values/invoke-unit/infer pop3@) - (define-values/invoke-unit/sig net:pop3^ - net:pop3@) - - (provide-signature-elements net:pop3^)) + (provide-signature-elements pop3^)) #| diff --git a/collects/net/qp-sig.ss b/collects/net/qp-sig.ss index c381844145..90b30ca5a5 100644 --- a/collects/net/qp-sig.ss +++ b/collects/net/qp-sig.ss @@ -1,17 +1,12 @@ -(module qp-sig mzscheme - (require (lib "unitsig.ss")) +(module qp-sig (lib "a-signature.ss") + ;; -- exceptions raised -- + (struct qp-error () -setters -constructor) + (struct qp-wrong-input () -setters -constructor) + (struct qp-wrong-line-size (size) -setters -constructor) - (provide net:qp^) - (define-signature net:qp^ - ( - ;; -- exceptions raised -- - (struct qp-error () -setters (- make-qp-error)) - (struct qp-wrong-input () -setters (- make-qp-wrong-input)) - (struct qp-wrong-line-size (size) -setters (- make-qp-wrong-line-size)) - - ;; -- qp methods -- - qp-encode - qp-decode - qp-encode-stream - qp-decode-stream - ))) + ;; -- qp methods -- + qp-encode + qp-decode + qp-encode-stream + qp-decode-stream + ) diff --git a/collects/net/qp-unit.ss b/collects/net/qp-unit.ss index b02c37ac86..d9510bec50 100644 --- a/collects/net/qp-unit.ss +++ b/collects/net/qp-unit.ss @@ -25,15 +25,12 @@ ;; ;; Commentary: -(module qp-unit mzscheme +(module qp-unit (lib "a-unit.ss") (require "qp-sig.ss" - (lib "unitsig.ss") (lib "etc.ss")) - (provide net:qp@) - (define net:qp@ - (unit/sig net:qp^ - (import) + (import) + (export qp^) ;; Exceptions: ;; String or input-port expected: @@ -171,6 +168,6 @@ (vector-set! hex-values (+ i 65) (+ 10 i)) (vector-set! hex-values (+ i 97) (+ 10 i)) (vector-set! hex-bytes (+ 10 i) (+ i 65)) - (loop (add1 i))))))) + (loop (add1 i))))) ;;; qp-unit.ss ends here diff --git a/collects/net/qp.ss b/collects/net/qp.ss index 5c050b4e13..aacf091c4a 100644 --- a/collects/net/qp.ss +++ b/collects/net/qp.ss @@ -26,14 +26,12 @@ ;; Commentary: (module qp mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "qp-sig.ss" + "qp-unit.ss") - (require "qp-sig.ss") - (require "qp-unit.ss") + (define-values/invoke-unit/infer qp@) - (define-values/invoke-unit/sig net:qp^ - net:qp@) - - (provide-signature-elements net:qp^)) + (provide-signature-elements qp^)) ;;; qp.ss ends here \ No newline at end of file diff --git a/collects/net/sendmail-sig.ss b/collects/net/sendmail-sig.ss index f3ce211da7..3339c80e19 100644 --- a/collects/net/sendmail-sig.ss +++ b/collects/net/sendmail-sig.ss @@ -1,11 +1,5 @@ - -(module sendmail-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:sendmail^) - - (define-signature net:sendmail^ - (send-mail-message/port - send-mail-message - (struct no-mail-recipients ())))) +(module sendmail-sig (lib "a-signature.ss") + send-mail-message/port + send-mail-message + (struct no-mail-recipients ())) diff --git a/collects/net/sendmail-unit.ss b/collects/net/sendmail-unit.ss index b3cc5d700c..45f3e42646 100644 --- a/collects/net/sendmail-unit.ss +++ b/collects/net/sendmail-unit.ss @@ -1,14 +1,9 @@ +(module sendmail-unit (lib "a-unit.ss") + (require (lib "process.ss") + "sendmail-sig.ss") -(module sendmail-unit mzscheme - (require (lib "unitsig.ss") - (lib "process.ss")) - - (require "sendmail-sig.ss") - - (provide net:sendmail@) - (define net:sendmail@ - (unit/sig net:sendmail^ - (import) + (import) + (export sendmail^) (define-struct (no-mail-recipients exn) ()) @@ -121,4 +116,4 @@ (display s writer) ; We use -i, so "." is not a problem (newline writer)) text) - (close-output-port writer))))))) + (close-output-port writer))))) diff --git a/collects/net/sendmail.ss b/collects/net/sendmail.ss index 0bb3dbb22e..49f0715afa 100644 --- a/collects/net/sendmail.ss +++ b/collects/net/sendmail.ss @@ -1,11 +1,8 @@ - (module sendmail mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "sendmail-sig.ss" + "sendmail-unit.ss") - (require "sendmail-sig.ss") - (require "sendmail-unit.ss") + (define-values/invoke-unit/infer sendmail@) - (define-values/invoke-unit/sig net:sendmail^ - net:sendmail@) - - (provide-signature-elements net:sendmail^)) + (provide-signature-elements sendmail^)) diff --git a/collects/net/smtp-sig.ss b/collects/net/smtp-sig.ss index 96dd7c769b..314cdcbe1f 100644 --- a/collects/net/smtp-sig.ss +++ b/collects/net/smtp-sig.ss @@ -1,11 +1,6 @@ - -(module smtp-sig mzscheme - (require (lib "unitsig.ss")) - - (provide net:smtp^) - (define-signature net:smtp^ - (smtp-sending-server - smtp-send-message - smtp-send-message* - smtp-sending-end-of-message))) +(module smtp-sig (lib "a-signature.ss") + smtp-sending-server + smtp-send-message + smtp-send-message* + smtp-sending-end-of-message) diff --git a/collects/net/smtp-unit.ss b/collects/net/smtp-unit.ss index fb95ca39a3..233135c2ca 100644 --- a/collects/net/smtp-unit.ss +++ b/collects/net/smtp-unit.ss @@ -1,15 +1,10 @@ +(module smtp-unit (lib "a-unit.ss") + (require (lib "kw.ss") + "base64.ss" + "smtp-sig.ss") -(module smtp-unit mzscheme - (require (lib "unitsig.ss") - (lib "kw.ss") - "base64.ss") - - (require "smtp-sig.ss") - - (provide net:smtp@) - (define net:smtp@ - (unit/sig net:smtp^ - (import) + (import) + (export smtp^) (define smtp-sending-server (make-parameter "localhost")) @@ -133,4 +128,4 @@ (values (current-input-port) (current-output-port)) (tcp-connect server opt-port-no))]) (smtp-send-message* r w sender recipients header message-lines - auth-user auth-passwd))))))) + auth-user auth-passwd))))) diff --git a/collects/net/smtp.ss b/collects/net/smtp.ss index 3f4cebcc8c..14f5a51bfc 100644 --- a/collects/net/smtp.ss +++ b/collects/net/smtp.ss @@ -1,11 +1,8 @@ - (module smtp mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss") + "smtp-sig.ss" + "smtp-unit.ss") - (require "smtp-sig.ss") - (require "smtp-unit.ss") + (define-values/invoke-unit/infer smtp@) - (define-values/invoke-unit/sig net:smtp^ - net:smtp@) - - (provide-signature-elements net:smtp^)) + (provide-signature-elements smtp^)) diff --git a/collects/net/ssl-tcp-unit.ss b/collects/net/ssl-tcp-unit.ss index e4cc3df183..51aec28936 100644 --- a/collects/net/ssl-tcp-unit.ss +++ b/collects/net/ssl-tcp-unit.ss @@ -1,6 +1,6 @@ (module ssl-tcp-unit mzscheme (provide make-ssl-tcp@) - (require (lib "unitsig.ss") + (require (lib "unit.ss") "tcp-sig.ss" (lib "mzssl.ss" "openssl") (lib "etc.ss")) @@ -8,9 +8,10 @@ (define (make-ssl-tcp@ server-cert-file server-key-file server-root-cert-files server-suggest-auth-file client-cert-file client-key-file client-root-cert-files) - (unit/sig net:tcp^ + (unit (import) - + (export tcp^) + (define ctx (ssl-make-client-context)) (when client-cert-file (ssl-load-certificate-chain! ctx client-cert-file)) diff --git a/collects/net/tcp-redirect.ss b/collects/net/tcp-redirect.ss index 5df9d328e0..cadcbd4378 100644 --- a/collects/net/tcp-redirect.ss +++ b/collects/net/tcp-redirect.ss @@ -1,7 +1,7 @@ (module tcp-redirect mzscheme (provide tcp-redirect) - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "async-channel.ss") (lib "etc.ss") "tcp-sig.ss") @@ -24,9 +24,9 @@ ; : (listof nat) -> (unit/sig () -> net:tcp^) (define tcp-redirect (opt-lambda (redirected-ports [redirected-address "127.0.0.1"]) - (unit/sig net:tcp^ + (unit (import) - + (export tcp^) ; : (make-pipe-listener nat (channel (cons iport oport))) (define-struct pipe-listener (port channel)) diff --git a/collects/net/tcp-sig.ss b/collects/net/tcp-sig.ss index 28dbbd2aa5..7b36fbd7c9 100644 --- a/collects/net/tcp-sig.ss +++ b/collects/net/tcp-sig.ss @@ -1,9 +1,5 @@ -(module tcp-sig mzscheme - (provide net:tcp^) - (require (lib "unitsig.ss")) - - (define-signature net:tcp^ - (tcp-abandon-port +(module tcp-sig (lib "a-signature.ss") + tcp-abandon-port tcp-accept tcp-accept/enable-break tcp-accept-ready? @@ -12,4 +8,4 @@ tcp-connect tcp-connect/enable-break tcp-listen - tcp-listener?))) \ No newline at end of file + tcp-listener?) \ No newline at end of file diff --git a/collects/net/tcp-unit.ss b/collects/net/tcp-unit.ss index d786c8b5bd..0973a6efce 100644 --- a/collects/net/tcp-unit.ss +++ b/collects/net/tcp-unit.ss @@ -1,34 +1,7 @@ (module tcp-unit mzscheme (provide tcp@) - (require (lib "unitsig.ss") - "tcp-sig.ss") - - ; Okay, this file looks retarded. Something is clearly wrong. - - - (define raw:tcp-abandon-port tcp-abandon-port) - (define raw:tcp-accept tcp-accept) - (define raw:tcp-accept/enable-break tcp-accept/enable-break) - (define raw:tcp-accept-ready? tcp-accept-ready?) - (define raw:tcp-addresses tcp-addresses) - (define raw:tcp-close tcp-close) - (define raw:tcp-connect tcp-connect) - (define raw:tcp-connect/enable-break tcp-connect/enable-break) - (define raw:tcp-listen tcp-listen) - (define raw:tcp-listener? tcp-listener?) - - (define tcp@ - (unit/sig net:tcp^ - (import) - - (define tcp-abandon-port raw:tcp-abandon-port) - (define tcp-accept raw:tcp-accept) - (define tcp-accept/enable-break raw:tcp-accept/enable-break) - (define tcp-accept-ready? raw:tcp-accept-ready?) - (define tcp-addresses raw:tcp-addresses) - (define tcp-close raw:tcp-close) - (define tcp-connect raw:tcp-connect) - (define tcp-connect/enable-break raw:tcp-connect/enable-break) - (define tcp-listen raw:tcp-listen) - (define tcp-listener? raw:tcp-listener?) - ))) \ No newline at end of file + + (require (lib "unit.ss") + "tcp-sig.ss") + + (define-unit-from-context tcp@ tcp^)) diff --git a/collects/net/uri-codec-sig.ss b/collects/net/uri-codec-sig.ss index 2d13a558cf..7c419c2689 100644 --- a/collects/net/uri-codec-sig.ss +++ b/collects/net/uri-codec-sig.ss @@ -1,14 +1,10 @@ -(module uri-codec-sig mzscheme - (require (lib "unitsig.ss")) - (provide net:uri-codec^) - - (define-signature net:uri-codec^ - (uri-encode - uri-decode - uri-path-segment-encode - uri-path-segment-decode - form-urlencoded-encode - form-urlencoded-decode - alist->form-urlencoded - form-urlencoded->alist - current-alist-separator-mode))) \ No newline at end of file +(module uri-codec-sig (lib "a-signature.ss") + uri-encode + uri-decode + uri-path-segment-encode + uri-path-segment-decode + form-urlencoded-encode + form-urlencoded-decode + alist->form-urlencoded + form-urlencoded->alist + current-alist-separator-mode) \ No newline at end of file diff --git a/collects/net/uri-codec-unit.ss b/collects/net/uri-codec-unit.ss index 8c1f15882e..0fb66738f0 100644 --- a/collects/net/uri-codec-unit.ss +++ b/collects/net/uri-codec-unit.ss @@ -167,21 +167,17 @@ JALQefhDMCATcl2/bZL0bw== ;; Draws inspiration from encode-decode.scm by Kurt Normark and a code ;; sample provided by Eli Barzilay -(module uri-codec-unit mzscheme +(module uri-codec-unit (lib "a-unit.ss") - (require (lib "unitsig.ss") - (lib "match.ss") + (require (lib "match.ss") (lib "string.ss") (lib "list.ss") (lib "etc.ss") "uri-codec-sig.ss") - (provide uri-codec@) - - (define uri-codec@ - (unit/sig net:uri-codec^ - (import) - + (import) + (export uri-codec^) + (define (self-map-char ch) (cons ch ch)) (define (self-map-chars str) (map self-map-char (string->list str))) @@ -375,6 +371,6 @@ JALQefhDMCATcl2/bZL0bw== (raise-type-error 'current-alist-separator-mode "'amp, 'semi, or 'amp-or-semi" s)) - s)))))) + s)))) ;;; uri-codec-unit.ss ends here diff --git a/collects/net/uri-codec.ss b/collects/net/uri-codec.ss index ecd6f4d713..302f382d87 100644 --- a/collects/net/uri-codec.ss +++ b/collects/net/uri-codec.ss @@ -1,9 +1,8 @@ (module uri-codec mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") "uri-codec-sig.ss" "uri-codec-unit.ss") - (provide-signature-elements net:uri-codec^) + (provide-signature-elements uri-codec^) - (define-values/invoke-unit/sig net:uri-codec^ - uri-codec@)) \ No newline at end of file + (define-values/invoke-unit/infer uri-codec@)) \ No newline at end of file diff --git a/collects/net/url-sig.ss b/collects/net/url-sig.ss index 7094f19e41..22d55b06cf 100644 --- a/collects/net/url-sig.ss +++ b/collects/net/url-sig.ss @@ -1,19 +1,15 @@ -(module url-sig mzscheme - (require (lib "unitsig.ss")) - (provide net:url^) - - (define-signature net:url^ - (get-pure-port - get-impure-port - post-pure-port - post-impure-port - display-pure-port - purify-port - netscape/string->url - string->url - url->string - call/input-url - combine-url/relative - url-exception? - current-proxy-servers))) +(module url-sig (lib "a-signature.ss") + get-pure-port + get-impure-port + post-pure-port + post-impure-port + display-pure-port + purify-port + netscape/string->url + string->url + url->string + call/input-url + combine-url/relative + url-exception? + current-proxy-servers) diff --git a/collects/net/url-unit.ss b/collects/net/url-unit.ss index c354a0c177..b04e20bb8b 100644 --- a/collects/net/url-unit.ss +++ b/collects/net/url-unit.ss @@ -11,7 +11,7 @@ (module url-unit mzscheme (require (lib "file.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "port.ss") (lib "string.ss") (lib "list.ss") @@ -26,9 +26,9 @@ (define url:os-type (system-type)) (define (set-url:os-type! new) (set! url:os-type new)) - (define url@ - (unit/sig net:url^ - (import net:tcp^) + (define-unit url@ + (import tcp^) + (export url^) (define-struct (url-exception exn:fail) ()) @@ -445,4 +445,4 @@ (apply string-append (reverse! r)) (loop (cdr strings) (list* (car strings) sep r))))])) - ))) + )) diff --git a/collects/net/url.ss b/collects/net/url.ss index daa4d021e8..e7594f68b6 100644 --- a/collects/net/url.ss +++ b/collects/net/url.ss @@ -1,5 +1,5 @@ (module url mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "contract.ss") "url-structs.ss" "url-sig.ss" @@ -7,14 +7,11 @@ "tcp-sig.ss" "tcp-unit.ss") - (define-values/invoke-unit/sig - net:url^ - (compound-unit/sig - (import) - (link - [T : net:tcp^ (tcp@)] - [U : net:url^ (url@ T)]) - (export (open U)))) + (define-compound-unit/infer url+tcp@ + (import) (export url^) + (link tcp@ url@)) + + (define-values/invoke-unit/infer url+tcp@) (provide (struct url (scheme diff --git a/collects/profj/tester.scm b/collects/profj/tester.scm index 1f846df40b..3280426852 100644 --- a/collects/profj/tester.scm +++ b/collects/profj/tester.scm @@ -2,7 +2,7 @@ (require (lib "mred.ss" "mred") (lib "tool.ss" "drscheme") - (lib "unitsig.ss") + (prefix u: (lib "unit.ss")) (lib "framework.ss" "framework") (lib "string-constant.ss" "string-constants") (lib "class.ss") @@ -577,9 +577,9 @@ (define-local-member-name toggle-test-status test-froze-colorer? begin-test-color end-test-color) (define test-tool@ - (unit/sig drscheme:tool-exports^ - (import drscheme:tool^) - + (u:unit + (u:import drscheme:tool^) + (u:export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) diff --git a/collects/profj/tool.ss b/collects/profj/tool.ss index 2b8ac35da0..278f31db73 100644 --- a/collects/profj/tool.ss +++ b/collects/profj/tool.ss @@ -1,6 +1,7 @@ (module tool mzscheme (require (lib "tool.ss" "drscheme") (lib "contract.ss") - (lib "mred.ss" "mred") (lib "framework.ss" "framework") (lib "unitsig.ss") + (lib "mred.ss" "mred") (lib "framework.ss" "framework") + (prefix u: (lib "unit.ss")) (lib "file.ss") (lib "include-bitmap.ss" "mrlib") (lib "etc.ss") (lib "class.ss") @@ -18,9 +19,9 @@ (preferences:set-default 'profj:classpath null (lambda (v) (and (list? v) (andmap string? v)))) (define tool@ - (unit/sig drscheme:tool-exports^ - (import drscheme:tool^) - + (u:unit + (u:import drscheme:tool^) + (u:export drscheme:tool-exports^) ;Set the Java editing colors (define color-prefs-table `((keyword ,(make-object color% "black") ,(string-constant profj-java-mode-color-keyword)) diff --git a/collects/profjBoxes/private/example-box.ss b/collects/profjBoxes/private/example-box.ss index 0517968bbf..cd29558aef 100644 --- a/collects/profjBoxes/private/example-box.ss +++ b/collects/profjBoxes/private/example-box.ss @@ -7,7 +7,7 @@ (lib "list.ss") (lib "embedded-gui.ss" "embedded-gui") (lib "match.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "tool.ss" "drscheme") (lib "framework.ss" "framework") (lib "parser.ss" "profj") @@ -24,9 +24,9 @@ (define min-field-width 50) (define-signature example-box^ (example-box%)) - (define example-box@ - (unit/sig example-box^ - (import drscheme:tool^) + (define-unit example-box@ + (import drscheme:tool^) + (export example-box^) ;; A readable-snip<%> of an examples box to allow GUI contruction of data examples. (define example-box% @@ -249,4 +249,4 @@ (send (get-pasteboard) lock-alignment false) )) )) - ) \ No newline at end of file + diff --git a/collects/profjBoxes/private/interactions-box.ss b/collects/profjBoxes/private/interactions-box.ss index 6a0fd46e83..1120a395a5 100644 --- a/collects/profjBoxes/private/interactions-box.ss +++ b/collects/profjBoxes/private/interactions-box.ss @@ -7,7 +7,7 @@ (lib "list.ss") (lib "embedded-gui.ss" "embedded-gui") (lib "match.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "tool.ss" "drscheme") (lib "framework.ss" "framework") (lib "readerr.ss" "syntax") @@ -23,10 +23,9 @@ (define-signature interactions-box^ (interactions-box%)) - (define interactions-box@ - (unit/sig interactions-box^ + (define-unit interactions-box@ (import drscheme:tool^ text->syntax-object^) - + (export interactions-box^) (define interactions-box% (class* editor-snip% (readable-snip<%>) (inherit set-snipclass) @@ -252,4 +251,4 @@ (super-new) )) )) - ) \ No newline at end of file + diff --git a/collects/profjBoxes/tool.ss b/collects/profjBoxes/tool.ss index 81e302420e..a42a5c66fd 100644 --- a/collects/profjBoxes/tool.ss +++ b/collects/profjBoxes/tool.ss @@ -5,17 +5,16 @@ (require (lib "class.ss") (lib "contract.ss") (lib "mred.ss" "mred") - (lib "unitsig.ss") + (lib "unit.ss") (lib "string-constant.ss" "string-constants") (lib "tool.ss" "drscheme") "private/example-box.ss" "private/interactions-box.ss" (lib "text-syntax-object.ss" "test-suite" "private")) - (define extentions@ - (unit/sig drscheme:tool-exports^ - (import drscheme:tool^ example-box^ interactions-box^) - + (define-unit extentions@ + (import drscheme:tool^ example-box^ interactions-box^) + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) @@ -61,15 +60,11 @@ )) (drscheme:get/extend:extend-unit-frame frame-mixin) - (drscheme:language:register-capability 'profj:special:java-examples-box (flat-contract boolean?) #f))) + (drscheme:language:register-capability 'profj:special:java-examples-box (flat-contract boolean?) #f)) (define tool@ - (compound-unit/sig - (import (TOOL : drscheme:tool^)) - (link (EXT : drscheme:tool-exports^ (extentions@ TOOL EXAMPLES INTERACTIONS)) - (EXAMPLES : example-box^ (example-box@ TOOL)) - (INTERACTIONS : interactions-box^ (interactions-box@ TOOL SYNTAX)) - (SYNTAX : text->syntax-object^ (text->syntax-object@ TOOL))) - (export (var (EXT phase1)) - (var (EXT phase2))))) + (compound-unit/infer + (import drscheme:tool^) + (export drscheme:tool-exports^) + (link extentions@ example-box@ interactions-box@ text->syntax-object@))) ) diff --git a/collects/profjWizard/tool.ss b/collects/profjWizard/tool.ss index 25a820990b..478d59c1bd 100644 --- a/collects/profjWizard/tool.ss +++ b/collects/profjWizard/tool.ss @@ -9,7 +9,7 @@ (only (lib "drsig.ss" "drscheme" "private") drscheme:language-configuration^) (lib "framework.ss" "framework") (lib "mred.ss" "mred") - (lib "unitsig.ss") + (lib "unit.ss") (lib "etc.ss") (lib "class.ss") (lib "string-constant.ss" "string-constants") @@ -22,9 +22,9 @@ (define INSERT-JAVA-UNION "Insert Java Union") (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) diff --git a/collects/repos-time-stamp/time-stamp.ss b/collects/repos-time-stamp/time-stamp.ss index 8c80ac1180..c88a65f240 100644 --- a/collects/repos-time-stamp/time-stamp.ss +++ b/collects/repos-time-stamp/time-stamp.ss @@ -1,7 +1,7 @@ (module time-stamp mzscheme (require (lib "tool.ss" "drscheme") - (lib "unitsig.ss") + (lib "unit.ss") (lib "framework.ss" "framework")) (require "stamp.ss") @@ -11,8 +11,9 @@ (require "stamp.ss") (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) (version:add-spec '-svn stamp)))) diff --git a/collects/setup/doc.txt b/collects/setup/doc.txt index 059787b2a7..a5eec68c93 100644 --- a/collects/setup/doc.txt +++ b/collects/setup/doc.txt @@ -191,7 +191,7 @@ installing a single .plt file: ------------------- The _setup-unit.ss_ library in the setup collection exports a _setup@_ -signed unit that imports +unit that imports setup-option^ - described below compiler^ - from "sig.ss" in the "compiler" collection diff --git a/collects/setup/option-sig.ss b/collects/setup/option-sig.ss index 2a6b1c78a4..517d218662 100644 --- a/collects/setup/option-sig.ss +++ b/collects/setup/option-sig.ss @@ -1,6 +1,6 @@ (module option-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide setup-option^) diff --git a/collects/setup/option-unit.ss b/collects/setup/option-unit.ss index ae891e5b7e..593e5a7be7 100644 --- a/collects/setup/option-unit.ss +++ b/collects/setup/option-unit.ss @@ -1,14 +1,14 @@ (module option-unit mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "option-sig.ss") (provide setup:option@) - (define setup:option@ - (unit/sig setup-option^ + (define-unit setup:option@ (import) + (export setup-option^) (define verbose (make-parameter #f)) (define make-verbose (make-parameter #f)) @@ -31,4 +31,4 @@ (define current-target-directory-getter (make-parameter current-directory)) (define current-target-plt-directory-getter (make-parameter - (lambda (preferred main-collects-parent-dir choices) preferred)))))) + (lambda (preferred main-collects-parent-dir choices) preferred))))) diff --git a/collects/setup/plt-installer-sig.ss b/collects/setup/plt-installer-sig.ss index 2d3d77de32..d209ae6c92 100644 --- a/collects/setup/plt-installer-sig.ss +++ b/collects/setup/plt-installer-sig.ss @@ -1,5 +1,5 @@ (module plt-installer-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide setup:plt-installer^) (define-signature setup:plt-installer^ (run-installer diff --git a/collects/setup/plt-installer-unit.ss b/collects/setup/plt-installer-unit.ss index 2d87a8de5a..f4b32c23b9 100644 --- a/collects/setup/plt-installer-unit.ss +++ b/collects/setup/plt-installer-unit.ss @@ -1,18 +1,17 @@ (module plt-installer-unit mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred") (lib "class.ss") (lib "etc.ss") "plt-installer-sig.ss" (prefix single: "plt-single-installer.ss") (lib "string-constant.ss" "string-constants")) - + (provide plt-installer@) - - (define plt-installer@ - (unit/sig setup:plt-installer^ - (import mred^) + (define-unit plt-installer@ + (import mred^) + (export setup:plt-installer^) (define on-installer-run (make-parameter void)) @@ -129,4 +128,4 @@ (printf ">>> Cancelled <<<~n")) (begin-busy-cursor) d)))) - cleanup-thunk)))))) + cleanup-thunk))))) diff --git a/collects/setup/plt-installer.ss b/collects/setup/plt-installer.ss index 7be81c804f..8200e6e4a7 100644 --- a/collects/setup/plt-installer.ss +++ b/collects/setup/plt-installer.ss @@ -1,10 +1,13 @@ (module plt-installer mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") "plt-installer-sig.ss" "plt-installer-unit.ss" - (lib "mred.ss" "mred") + (lib "mred-unit.ss" "mred") (lib "mred-sig.ss" "mred")) (provide-signature-elements setup:plt-installer^) - (define-values/invoke-unit/sig setup:plt-installer^ plt-installer@ #f mred^)) + (define-compound-unit/infer plt-installer+mred@ + (import) (export setup:plt-installer^) + (link standard-mred@ plt-installer@)) + (define-values/invoke-unit/infer plt-installer+mred@)) diff --git a/collects/setup/plt-single-installer.ss b/collects/setup/plt-single-installer.ss index 2a25a44fe5..657b153679 100644 --- a/collects/setup/plt-single-installer.ss +++ b/collects/setup/plt-single-installer.ss @@ -1,5 +1,5 @@ (module plt-single-installer mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "etc.ss") ;; All the rest are to get the imports for setup@: @@ -42,51 +42,40 @@ (let ([thd (thread (lambda () - (invoke-unit/sig - (compound-unit/sig + (define-unit set-options@ + (import setup-option^ compiler^) + (export) + ;; >>>>>>>>>>>>>> <<<<<<<<<<<<<<< + ;; Here's where we tell setup the archive file! + (unless clean? + (archives (list file))) + + ;; Here's where we make get a directory: + (current-target-directory-getter + get-target-dir) + + (when planet-spec + (specific-planet-dirs (list planet-spec))) + + (when clean? + (clean #t) + (make-zo #f) + (make-so #f) + (make-launchers #f) + (make-info-domain #t) + (call-install #f))) + (invoke-unit + (compound-unit/infer (import) - (link [launcher : launcher^ (launcher@ dcompile dlink)] - [dcompile : dynext:compile^ (dynext:compile@)] - [dlink : dynext:link^ (dynext:link@)] - [dfile : dynext:file^ (dynext:file@)] - [option : compiler:option^ (compiler:option@)] - [compiler : compiler^ (compiler@ - option - dcompile - dlink - dfile)] - [soption : setup-option^ (setup:option@)] - [set-options : () ((unit/sig () - (import setup-option^ compiler^) - ;; >>>>>>>>>>>>>> <<<<<<<<<<<<<<< - ;; Here's where we tell setup the archive file! - (unless clean? - (archives (list file))) - - ;; Here's where we make get a directory: - (current-target-directory-getter - get-target-dir) - - (when planet-spec - (specific-planet-dirs (list planet-spec))) - - (when clean? - (clean #t) - (make-zo #f) - (make-so #f) - (make-launchers #f) - (make-info-domain #t) - (call-install #f)) - - - ) - soption - compiler)] - [setup : () (setup@ - soption - compiler - option - launcher)]) - (export)))))]) + (export) + (link launcher@ + dynext:compile@ + dynext:link@ + dynext:file@ + compiler:option@ + compiler@ + setup:option@ + set-options@ + setup@)))))]) (thread-wait thd) (custodian-shutdown-all cust)))))) diff --git a/collects/setup/setup-go.ss b/collects/setup/setup-go.ss index 06eec53b79..946fd72d42 100644 --- a/collects/setup/setup-go.ss +++ b/collects/setup/setup-go.ss @@ -1,15 +1,14 @@ (module setup-go mzscheme (require "setup-cmdline.ss" - (lib "unitsig.ss") + (lib "unit.ss") "option-sig.ss" "setup-unit.ss" "option-unit.ss" (lib "cm.ss")) - (define-values/invoke-unit/sig setup-option^ - setup:option@) + (define-values/invoke-unit/infer setup:option@) (define-values (x-flags x-specific-collections x-specific-planet-packages x-archives) (parse-cmdline (current-command-line-arguments))) @@ -58,23 +57,10 @@ (lib "option-unit.ss" "compiler") (lib "compiler-unit.ss" "compiler")) - (invoke-unit/sig - (compound-unit/sig + (invoke-unit + (compound-unit/infer (import (SOPTION : setup-option^)) - (link [launcher : launcher^ (launcher@ dcompile dlink)] - [dcompile : dynext:compile^ (dynext:compile@)] - [dlink : dynext:link^ (dynext:link@)] - [dfile : dynext:file^ (dynext:file@)] - [option : compiler:option^ (compiler:option@)] - [compiler : compiler^ (compiler@ - option - dcompile - dlink - dfile)] - [setup : () (setup@ - SOPTION - compiler - option - launcher)]) - (export)) - setup-option^)) + (export) + (link launcher@ dynext:compile@ dynext:link@ dynext:file@ + compiler:option@ compiler@ setup@)) + (import setup-option^))) diff --git a/collects/setup/setup-unit.ss b/collects/setup/setup-unit.ss index 8e398e1a40..5f8748efcf 100644 --- a/collects/setup/setup-unit.ss +++ b/collects/setup/setup-unit.ss @@ -3,8 +3,7 @@ ; Calls `exit' when done. (module setup-unit mzscheme - (require (lib "unitsig.ss") - (lib "unit.ss") + (require (lib "unit.ss") (lib "file.ss") (lib "list.ss") (lib "cm.ss") @@ -24,12 +23,12 @@ (provide setup@) - (define setup@ - (unit/sig () + (define-unit setup@ (import setup-option^ compiler^ - (compiler:option : compiler:option^) + (prefix compiler:option: compiler:option^) launcher^) + (export) (define setup-fprintf (lambda (p s . args) @@ -849,4 +848,4 @@ (read-line)) (exit 1)) - (exit 0)))) + (exit 0))) diff --git a/collects/setup/unpack.ss b/collects/setup/unpack.ss index c52b948b82..f080b2dbf0 100644 --- a/collects/setup/unpack.ss +++ b/collects/setup/unpack.ss @@ -5,7 +5,6 @@ (lib "inflate.ss") (lib "file.ss") (lib "list.ss") - (lib "unit.ss") (lib "base64.ss" "net") (lib "getinfo.ss" "setup") "dirs.ss") @@ -144,7 +143,7 @@ (let* ([n (make-namespace)] [info (let ([orig (current-namespace)]) (parameterize ([current-namespace n]) - (namespace-require '(lib "unit.ss")) + (namespace-require '(lib "unit200.ss")) (eval (read p))))]) (unless (and (procedure? info) (procedure-arity-includes? info 2)) @@ -286,7 +285,7 @@ (print-status (format "Unpacking ~a from ~a" name archive)) (let ([u (eval (read p) n)]) (unless (eval `(unit? ,u) n) - (error "expected a unit, got" u)) + (error "expected a v200 unit, got" u)) (make-directory* (car target-dir-info)) (let ([unmztar (lambda (filter) (unmztar p filter diff --git a/collects/sirmail/folderr.ss b/collects/sirmail/folderr.ss index c0c3aa05d0..73623ceb2a 100644 --- a/collects/sirmail/folderr.ss +++ b/collects/sirmail/folderr.ss @@ -1,6 +1,6 @@ (module folderr mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "framework.ss" "framework") (lib "mred-sig.ss" "mred")) @@ -18,14 +18,14 @@ (require (lib "mzssl.ss" "openssl")) (provide folder@) - (define folder@ - (unit/sig () + (define-unit folder@ (import sirmail:environment^ - (shutdown-folders-window) + sirmail:shutdown-folder^ sirmail:options^ mred^ - net:imap^ + imap^ hierlist^) + (export) (define (show-error x frame) (message-box "Error" @@ -469,4 +469,4 @@ (current-exception-handler (initial-exception-handler)) - frame))) + frame)) diff --git a/collects/sirmail/optionr.ss b/collects/sirmail/optionr.ss index b253b74504..7dc8e66e7d 100644 --- a/collects/sirmail/optionr.ss +++ b/collects/sirmail/optionr.ss @@ -1,6 +1,6 @@ (module optionr mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "string.ss")) (require (lib "imap-sig.ss" "net") @@ -17,11 +17,11 @@ ;; (which is only instantiated once). (provide option@) - (define option@ - (unit/sig sirmail:options^ - (import sirmail:environment^ - net:imap^ + (define-unit option@ + (import sirmail:environment^ + imap^ mred^) + (export sirmail:options^) (define (parse-server-name s default-port) (let ([m (regexp-match "^([^:]*):([^:]*)$" s)]) @@ -92,4 +92,4 @@ (define (WARN-DOWNLOAD-SIZE) (get-pref 'sirmail:warn-download-size)) - (define (SHOW-URLS) (get-pref 'sirmail:show-urls?))))) \ No newline at end of file + (define (SHOW-URLS) (get-pref 'sirmail:show-urls?)))) \ No newline at end of file diff --git a/collects/sirmail/readr.ss b/collects/sirmail/readr.ss index 1e67d1db25..0d6e648373 100644 --- a/collects/sirmail/readr.ss +++ b/collects/sirmail/readr.ss @@ -11,7 +11,7 @@ ;; (module readr mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "file.ss") (lib "mred-sig.ss" "mred") @@ -45,20 +45,20 @@ (define no-subject-string "") (provide read@) - (define read@ - (unit/sig sirmail:read^ + (define-unit read@ (import sirmail:options^ sirmail:environment^ sirmail:utils^ sirmail:send^ mred^ - net:imap^ - net:smtp^ - net:head^ - net:base64^ - (mime : net:mime^) - net:qp^ + imap^ + smtp^ + head^ + base64^ + (prefix mime: mime^) + qp^ hierlist^) + (export sirmail:read^) ;; This will be set to the frame object (define main-frame #f) @@ -3167,4 +3167,4 @@ (loop eou-pos))))))) (hilite-urls/prefix "http:") (hilite-urls/prefix "https:") - (hilite-urls/prefix "ftp:"))))) + (hilite-urls/prefix "ftp:")))) diff --git a/collects/sirmail/sendr.ss b/collects/sirmail/sendr.ss index 788b18287c..2aa5fc719b 100644 --- a/collects/sirmail/sendr.ss +++ b/collects/sirmail/sendr.ss @@ -3,7 +3,7 @@ ;; function creates a compose-window instance. (module sendr mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "mred-sig.ss" "mred") (lib "framework.ss" "framework")) @@ -29,20 +29,20 @@ (define smtp-passwords (make-hash-table 'equal)) (provide send@) - (define send@ - (unit/sig sirmail:send^ - (import (exit-sirmail) + (define-unit send@ + (import sirmail:exit^ sirmail:utils^ sirmail:options^ sirmail:read^ - (env : sirmail:environment^) + (prefix env: sirmail:environment^) mred^ - net:imap^ - net:smtp^ - net:head^ - net:base64^ - net:qp^ + imap^ + smtp^ + head^ + base64^ + qp^ hierlist^) + (export sirmail:send^) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Constants ;; @@ -946,7 +946,7 @@ (lambda () (send edit end-edit-sequence) (send edit set-wordbreak-map wbm))) - #t)))) + #t))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Uptime ;; diff --git a/collects/sirmail/sirmail.ss b/collects/sirmail/sirmail.ss index 0ebe403a23..b4f79c24bb 100644 --- a/collects/sirmail/sirmail.ss +++ b/collects/sirmail/sirmail.ss @@ -2,7 +2,7 @@ ;; (with a mail composer, too) (module sirmail mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "mred-sig.ss" "mred") (lib "mred.ss" "mred") @@ -84,17 +84,16 @@ [(mailbox-name mailbox-options) (start-new-window (lambda () - (invoke-unit/sig - sirmail@ - sirmail:environment^ - mred^ - net:imap^ - net:smtp^ - net:head^ - net:base64^ - net:mime^ - net:qp^ - hierlist^)))])) + (invoke-unit sirmail@ + (import sirmail:environment^ + mred^ + imap^ + smtp^ + head^ + base64^ + mime^ + qp^ + hierlist^))))])) ;; There's only one Folders window ---------------------------------------- @@ -126,32 +125,23 @@ (start-new-window (lambda () (set! folders-window - (invoke-unit/sig - (compound-unit/sig - (import [env : sirmail:environment^] - [s : (shutdown-folders-window)] - [mred : mred^] - [imap : net:imap^] - [hierlist : hierlist^]) - (link [options : sirmail:options^ - (option@ - env - imap - mred)] - [folder : () - (folder@ - env - s - options - mred imap - hierlist)]) - (export)) - sirmail:environment^ - (shutdown-folders-window) - mred^ - net:imap^ - hierlist^))))))))) - + (let () + (define-compound-unit/infer together@ + (import [env : sirmail:environment^] + [s : sirmail:shutdown-folder^] + [mred : mred^] + [imap : imap^] + [hierlist : hierlist^]) + (export) + (link option@ folder@)) + (invoke-unit together@ + (import + sirmail:environment^ + sirmail:shutdown-folder^ + mred^ + imap^ + hierlist^))))))))))) + (define (get-active-folder) (with-folders-lock (lambda () diff --git a/collects/sirmail/sirmailr.ss b/collects/sirmail/sirmailr.ss index 1dc6f09f6d..c0fe762086 100644 --- a/collects/sirmail/sirmailr.ss +++ b/collects/sirmail/sirmailr.ss @@ -1,6 +1,6 @@ (module sirmailr mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "mred-sig.ss" "mred")) (require "sirmails.ss") @@ -22,33 +22,20 @@ ;; The sirmail@ unit implements a single reader window. See ;; "sirmail.ss" for its use: (provide sirmail@) - (define sirmail@ - (compound-unit/sig - (import (ENV : sirmail:environment^) - (MRED : mred^) - (IMAP : net:imap^) - (SMTP : net:smtp^) - (HEAD : net:head^) - (BASE64 : net:base64^) - (MIME : net:mime^) - (QP : net:qp^) - (HIER : hierlist^)) - (link [UTILS : sirmail:utils^ - (util@ - MRED - BASE64 - QP)] - [OPTIONS : sirmail:options^ - (option@ - ENV - IMAP - MRED)] - [READ : sirmail:read^ - (read@ - OPTIONS ENV UTILS SEND - MRED IMAP SMTP HEAD BASE64 MIME QP HIER)] - [SEND : sirmail:send^ - (send@ - (ENV : (exit-sirmail)) UTILS OPTIONS READ ENV - MRED IMAP SMTP HEAD BASE64 QP HIER)]) - (export)))) + (define-compound-unit/infer sirmail@ + (import (ENV : sirmail:environment^) + mred^ + imap^ + smtp^ + head^ + base64^ + mime^ + qp^ + hierlist^) + (export) + + (link util@ + option@ + read@ + [() send@ ENV]))) + diff --git a/collects/sirmail/sirmails.ss b/collects/sirmail/sirmails.ss index 7ff7e298d4..851075510f 100644 --- a/collects/sirmail/sirmails.ss +++ b/collects/sirmail/sirmails.ss @@ -1,17 +1,21 @@ (module sirmails mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) - (provide sirmail:environment^) - (define-signature sirmail:environment^ + (provide sirmail:exit^ + sirmail:environment^) + + (define-signature sirmail:exit^ + (exit-sirmail)) + + (define-signature sirmail:environment^ extends sirmail:exit^ (mailbox-name mailbox-options open-folders-window get-active-folder open-mailbox - start-new-window - exit-sirmail)) + start-new-window)) (provide sirmail:utils^) (define-signature sirmail:utils^ @@ -85,4 +89,8 @@ (provide sirmail:read^) (define-signature sirmail:read^ - (queue-directory))) + (queue-directory)) + + (provide sirmail:shutdown-folder^) + (define-signature sirmail:shutdown-folder^ + (shutdown-folders-window))) diff --git a/collects/sirmail/utilr.ss b/collects/sirmail/utilr.ss index 9e0729d000..0a586d136f 100644 --- a/collects/sirmail/utilr.ss +++ b/collects/sirmail/utilr.ss @@ -1,6 +1,6 @@ (module utilr mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "class.ss") (lib "mred-sig.ss" "mred") (lib "qp-sig.ss" "net") @@ -12,11 +12,11 @@ (require "sirmails.ss") (provide util@) - (define util@ - (unit/sig sirmail:utils^ + (define-unit util@ (import mred^ - net:base64^ - net:qp^) + base64^ + qp^) + (export sirmail:utils^) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utilities ;; @@ -264,4 +264,4 @@ (define generalize-encoding unihead:generalize-encoding) (define parse-encoded unihead:decode-for-header) - (define encode-for-header unihead:encode-for-header)))) + (define encode-for-header unihead:encode-for-header))) diff --git a/collects/skipper/debug-tool.ss b/collects/skipper/debug-tool.ss index 2f5a00fb27..15811a5300 100644 --- a/collects/skipper/debug-tool.ss +++ b/collects/skipper/debug-tool.ss @@ -5,7 +5,7 @@ (prefix srfi: (lib "search.ss" "srfi" "1")) ;(lib "math.ss") (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") ;(lib "contract.ss") (lib "mred.ss" "mred") (prefix drscheme:arrow: (lib "arrow.ss" "drscheme")) @@ -20,9 +20,9 @@ (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define phase1 void) (define phase2 void) diff --git a/collects/skipper/marks.ss b/collects/skipper/marks.ss index 946102c558..fad79ac639 100644 --- a/collects/skipper/marks.ss +++ b/collects/skipper/marks.ss @@ -81,8 +81,8 @@ ; : identifier -> identifier (define (make-mark-binding-stx id) #`(case-lambda - [() #,(syntax-property id 'stepper-dont-check-for-function #t)] - [(v) (set! #,(syntax-property id 'stepper-dont-check-for-function #t) v)])) + [() #,id ] + [(v) (set! #,id v)])) (define (mark-bindings mark) (map list @@ -169,13 +169,13 @@ (let*-2vals ([kept-vars (binding-set-varref-set-intersect tail-bound free-vars)]) (if lifting? (let*-2vals ([let-bindings (filter (lambda (var) - (case (syntax-property var 'stepper-binding-type) + (case (stepper-syntax-property var 'stepper-binding-type) ((let-bound macro-bound) #t) ((lambda-bound stepper-temp non-lexical) #f) (else (error 'make-debug-info "varref ~a's binding-type info was not recognized: ~a" (syntax-e var) - (syntax-property var 'stepper-binding-type))))) + (stepper-syntax-property var 'stepper-binding-type))))) kept-vars)] [lifter-syms (map get-lifted-var let-bindings)]) (make-full-mark source label (append kept-vars lifter-syms))) diff --git a/collects/slideshow/cmdline.ss b/collects/slideshow/cmdline.ss index 19c4dd3e03..d7810ec341 100644 --- a/collects/slideshow/cmdline.ss +++ b/collects/slideshow/cmdline.ss @@ -1,7 +1,7 @@ (module cmdline mzscheme (require (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "file.ss") (lib "etc.ss") (lib "contract.ss") @@ -15,203 +15,190 @@ (provide cmdline@) - (define-syntax (define-at-end stx) - (syntax-case stx () - [(_ sig body ...) - (with-syntax ([(id ...) (let ([expr - (local-expand - #'(signature->symbols sig) - 'expression - null)]) - (map (lambda (id) - (datum->syntax-object - #'sig - (syntax-e id))) - (vector->list - (syntax-e (cadr (syntax->list expr))))))]) - #'(define-values (id ...) - (let () - body ... - (values id ...))))])) + (define-unit cmdline@ + (import) + (export (prefix final: cmdline^)) + + (define-values (screen-w screen-h) (values 1024 768)) + (define base-font-size 32) - (define cmdline@ - (unit/sig cmdline^ - (import) - - (define-at-end cmdline^ - (define-values (screen-w screen-h) (values 1024 768)) - (define base-font-size 32) + (define-values (actual-screen-w actual-screen-h) (get-display-size #t)) + (define-values (use-screen-w use-screen-h) (values actual-screen-w actual-screen-h)) - (define-values (actual-screen-w actual-screen-h) (get-display-size #t)) - (define-values (use-screen-w use-screen-h) (values actual-screen-w actual-screen-h)) + (define condense? #f) + (define printing? #f) + (define native-printing? #f) + (define commentary? #f) + (define commentary-on-slide? #f) + (define show-gauge? #f) + (define keep-titlebar? #f) + (define show-page-numbers? #t) + (define quad-view? #f) + (define pixel-scale (if quad-view? 1/2 1)) + (define print-slide-seconds? #f) + (define use-offscreen? #t) + (define use-transitions? use-offscreen?) + (define talk-duration-minutes #f) + (define trust-me? #f) + (define no-squash? #t) + (define two-frames? #f) + (define use-prefetch? #t) + (define use-prefetch-in-preview? #f) + (define print-target #f) + (define smoothing? #t) + + (define init-page 0) + + (define (die name . args) + (fprintf (current-error-port) "~a: ~a\n" name (apply format args)) + (exit -1)) + + (define file-to-load + (command-line + "slideshow" + (current-command-line-arguments) + [once-each + (("-d" "--preview") "show next-slide preview (useful on a non-mirroring display)" + (set! two-frames? #t)) + (("-p" "--print") "print (always to PostScript, except under Windows and Mac OS)" + (set! printing? #t) + (set! native-printing? #t)) + (("-P" "--ps") "print to PostScript" + (set! printing? #t)) + (("-o") file "set output file for PostScript printing" + (set! print-target file)) + (("-c" "--condense") "condense" + (set! condense? #t)) + (("-t" "--start") page "set the starting page" + (let ([n (string->number page)]) + (unless (and n + (integer? n) + (exact? n) + (positive? n)) + (die 'slideshow "argument to -t is not a positive exact integer: ~a" page)) + (set! init-page (sub1 n)))) + (("-q" "--quad") "show four slides at a time" + (set! quad-view? #t) + (set! pixel-scale 1/2)) + (("-n" "--no-stretch") "don't stretch the slide window to fit the screen" + (when (> actual-screen-w screen-w) + (set! actual-screen-w screen-w) + (set! actual-screen-h screen-h))) + (("-s" "--size") w h "use a by window" + (let ([nw (string->number w)] + [nh (string->number h)]) + (unless (and nw (< 0 nw 10000)) + (die 'slideshow "bad width: ~e" w)) + (unless (and nw (< 0 nh 10000)) + (die 'slideshow "bad height: ~e" h)) + (set! actual-screen-w nw) + (set! actual-screen-h nh))) + (("-a" "--squash") "scale to full window, even if not 4:3 aspect" + (set! no-squash? #f)) + (("-m" "--no-smoothing") + "disable anti-aliased drawing (usually faster)" + (set! smoothing? #f)) + ;; Disable --minutes, because it's not used + #; + (("-m" "--minutes") min "set talk duration in minutes" + (let ([n (string->number min)]) + (unless (and n + (integer? n) + (exact? n) + (positive? n)) + (die 'slideshow "argument to -m is not a positive exact integer: ~a" min)) + (set! talk-duration-minutes n))) + (("-i" "--immediate") "no transitions" + (set! use-transitions? #f)) + (("--trust") "allow slide program to write files and make network connections" + (set! trust-me? #t)) + (("--no-prefetch") "disable next-slide prefetch" + (set! use-prefetch? #f)) + (("--preview-prefetch") "use prefetch for next-slide preview" + (set! use-prefetch-in-preview? #t)) + (("--keep-titlebar") "give the slide window a title bar and resize border" + (set! keep-titlebar? #t)) + (("--comment") "display commentary in window" + (set! commentary? #t)) + (("--comment-on-slide") "display commentary on slide" + (set! commentary? #t) + (set! commentary-on-slide? #t)) + (("--time") "time seconds per slide" (set! print-slide-seconds? #t))] + [args slide-module-file + (cond + [(null? slide-module-file) #f] + [(null? (cdr slide-module-file)) + (let ([candidate (car slide-module-file)]) + (unless (file-exists? candidate) + (die 'slideshow "expected a filename on the commandline, given: ~a" + candidate)) + candidate)] + [else (die 'slideshow + "expects at most one module file, given ~a: ~s" + (length slide-module-file) + slide-module-file)])])) - (define condense? #f) - (define printing? #f) - (define native-printing? #f) - (define commentary? #f) - (define commentary-on-slide? #f) - (define show-gauge? #f) - (define keep-titlebar? #f) - (define show-page-numbers? #t) - (define quad-view? #f) - (define pixel-scale (if quad-view? 1/2 1)) - (define print-slide-seconds? #f) - (define use-offscreen? #t) - (define use-transitions? use-offscreen?) - (define talk-duration-minutes #f) - (define trust-me? #f) - (define no-squash? #t) - (define two-frames? #f) - (define use-prefetch? #t) - (define use-prefetch-in-preview? #f) - (define print-target #f) - (define smoothing? #t) - - (define init-page 0) - - (define (die name . args) - (fprintf (current-error-port) "~a: ~a\n" name (apply format args)) - (exit -1)) - - (define file-to-load - (command-line - "slideshow" - (current-command-line-arguments) - [once-each - (("-d" "--preview") "show next-slide preview (useful on a non-mirroring display)" - (set! two-frames? #t)) - (("-p" "--print") "print (always to PostScript, except under Windows and Mac OS)" - (set! printing? #t) - (set! native-printing? #t)) - (("-P" "--ps") "print to PostScript" - (set! printing? #t)) - (("-o") file "set output file for PostScript printing" - (set! print-target file)) - (("-c" "--condense") "condense" - (set! condense? #t)) - (("-t" "--start") page "set the starting page" - (let ([n (string->number page)]) - (unless (and n - (integer? n) - (exact? n) - (positive? n)) - (die 'slideshow "argument to -t is not a positive exact integer: ~a" page)) - (set! init-page (sub1 n)))) - (("-q" "--quad") "show four slides at a time" - (set! quad-view? #t) - (set! pixel-scale 1/2)) - (("-n" "--no-stretch") "don't stretch the slide window to fit the screen" - (when (> actual-screen-w screen-w) - (set! actual-screen-w screen-w) - (set! actual-screen-h screen-h))) - (("-s" "--size") w h "use a by window" - (let ([nw (string->number w)] - [nh (string->number h)]) - (unless (and nw (< 0 nw 10000)) - (die 'slideshow "bad width: ~e" w)) - (unless (and nw (< 0 nh 10000)) - (die 'slideshow "bad height: ~e" h)) - (set! actual-screen-w nw) - (set! actual-screen-h nh))) - (("-a" "--squash") "scale to full window, even if not 4:3 aspect" - (set! no-squash? #f)) - (("-m" "--no-smoothing") - "disable anti-aliased drawing (usually faster)" - (set! smoothing? #f)) - ;; Disable --minutes, because it's not used - #; - (("-m" "--minutes") min "set talk duration in minutes" - (let ([n (string->number min)]) - (unless (and n - (integer? n) - (exact? n) - (positive? n)) - (die 'slideshow "argument to -m is not a positive exact integer: ~a" min)) - (set! talk-duration-minutes n))) - (("-i" "--immediate") "no transitions" - (set! use-transitions? #f)) - (("--trust") "allow slide program to write files and make network connections" - (set! trust-me? #t)) - (("--no-prefetch") "disable next-slide prefetch" - (set! use-prefetch? #f)) - (("--preview-prefetch") "use prefetch for next-slide preview" - (set! use-prefetch-in-preview? #t)) - (("--keep-titlebar") "give the slide window a title bar and resize border" - (set! keep-titlebar? #t)) - (("--comment") "display commentary in window" - (set! commentary? #t)) - (("--comment-on-slide") "display commentary on slide" - (set! commentary? #t) - (set! commentary-on-slide? #t)) - (("--time") "time seconds per slide" (set! print-slide-seconds? #t))] - [args slide-module-file - (cond - [(null? slide-module-file) #f] - [(null? (cdr slide-module-file)) - (let ([candidate (car slide-module-file)]) - (unless (file-exists? candidate) - (die 'slideshow "expected a filename on the commandline, given: ~a" - candidate)) - candidate)] - [else (die 'slideshow - "expects at most one module file, given ~a: ~s" - (length slide-module-file) - slide-module-file)])])) + (when (or printing? condense?) + (set! use-transitions? #f)) - (when (or printing? condense?) - (set! use-transitions? #f)) + (when printing? + (set! use-offscreen? #f) + (set! use-prefetch? #f) + (set! keep-titlebar? #t)) - (when printing? - (set! use-offscreen? #f) - (set! use-prefetch? #f) - (set! keep-titlebar? #t)) + (dc-for-text-size + (if printing? + (let ([p (let ([pss (make-object ps-setup%)]) + (send pss set-mode 'file) + (send pss set-file + (if print-target + print-target + (if file-to-load + (path-replace-suffix (file-name-from-path file-to-load) + (if quad-view? + "-4u.ps" + ".ps")) + "untitled.ps"))) + (send pss set-orientation 'landscape) + (parameterize ([current-ps-setup pss]) + (if (and native-printing? + (not (memq (system-type) '(unix)))) + ;; Make printer-dc% + (begin + (when (can-get-page-setup-from-user?) + (let ([v (get-page-setup-from-user)]) + (if v + (send pss copy-from v) + (exit)))) + (make-object printer-dc% #f)) + ;; Make ps-dc%: + (make-object post-script-dc% (not print-target) #f #t #f))))]) + ;; Init page, set "screen" size, etc.: + (unless (send p ok?) (exit)) + (send p start-doc "Slides") + (send p start-page) + (set!-values (actual-screen-w actual-screen-h) (send p get-size)) + p) + + ;; Bitmaps give same size as the screen: + (make-object bitmap-dc% (make-object bitmap% 1 1)))) - (dc-for-text-size - (if printing? - (let ([p (let ([pss (make-object ps-setup%)]) - (send pss set-mode 'file) - (send pss set-file - (if print-target - print-target - (if file-to-load - (path-replace-suffix (file-name-from-path file-to-load) - (if quad-view? - "-4u.ps" - ".ps")) - "untitled.ps"))) - (send pss set-orientation 'landscape) - (parameterize ([current-ps-setup pss]) - (if (and native-printing? - (not (memq (system-type) '(unix)))) - ;; Make printer-dc% - (begin - (when (can-get-page-setup-from-user?) - (let ([v (get-page-setup-from-user)]) - (if v - (send pss copy-from v) - (exit)))) - (make-object printer-dc% #f)) - ;; Make ps-dc%: - (make-object post-script-dc% (not print-target) #f #t #f))))]) - ;; Init page, set "screen" size, etc.: - (unless (send p ok?) (exit)) - (send p start-doc "Slides") - (send p start-page) - (set!-values (actual-screen-w actual-screen-h) (send p get-size)) - p) - - ;; Bitmaps give same size as the screen: - (make-object bitmap-dc% (make-object bitmap% 1 1)))) + (start:trust-me? trust-me?) + (start:file-to-load file-to-load) - (start:trust-me? trust-me?) - (start:file-to-load file-to-load) + (set!-values (use-screen-w use-screen-h) + (if no-squash? + (if (< (/ actual-screen-w screen-w) + (/ actual-screen-h screen-h)) + (values actual-screen-w + (floor (* (/ actual-screen-w screen-w) screen-h))) + (values (floor (* (/ actual-screen-h screen-h) screen-w)) + actual-screen-h)) + (values actual-screen-w actual-screen-h))) + + ;; We need to copy all exported bindings into the final: + ;; form. Accumulating a unit from context and then invoking + ;; it is one way to do that... + (define-unit-from-context final@ cmdline^) + (define-values/invoke-unit final@ (import) (export (prefix final: cmdline^))))) - (set!-values (use-screen-w use-screen-h) - (if no-squash? - (if (< (/ actual-screen-w screen-w) - (/ actual-screen-h screen-h)) - (values actual-screen-w - (floor (* (/ actual-screen-w screen-w) screen-h))) - (values (floor (* (/ actual-screen-h screen-h) screen-w)) - actual-screen-h)) - (values actual-screen-w actual-screen-h))))))) diff --git a/collects/slideshow/code.ss b/collects/slideshow/code.ss index ae089e147d..a2dc188dda 100644 --- a/collects/slideshow/code.ss +++ b/collects/slideshow/code.ss @@ -1,14 +1,11 @@ (module code "slideshow.ss" (require (lib "code.ss" "texpict") - (lib "unitsig.ss")) + (lib "unit.ss")) (require-for-syntax (lib "to-string.ss" "syntax") (lib "list.ss")) - (define-values/invoke-unit/sig code^ - code@ - #f - code-params^) + (define-values/invoke-unit/infer code@) (define-code code typeset-code) diff --git a/collects/slideshow/core.ss b/collects/slideshow/core.ss index c46a8b3aa1..23f016fdb7 100644 --- a/collects/slideshow/core.ss +++ b/collects/slideshow/core.ss @@ -1,7 +1,7 @@ (module core mzscheme (require (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "file.ss") (lib "etc.ss") (lib "contract.ss") @@ -30,11 +30,11 @@ (define zero-inset (make-sinset 0 0 0 0)) - (define core@ - (unit/sig core^ - (import config^ (viewer : viewer^)) - (rename (local:condense? condense?) - (local:printing? printing?)) + (define-unit core@ + (import config^ (prefix viewer: viewer^)) + (export (rename core^ + (local:condense? condense?) + (local:printing? printing?))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Setup ;; @@ -851,4 +851,4 @@ 'done (begin (set! done? #t) - time))))))))))) + time)))))))))) diff --git a/collects/slideshow/param.ss b/collects/slideshow/param.ss index 37f4a89ae5..3ba1356d6a 100644 --- a/collects/slideshow/param.ss +++ b/collects/slideshow/param.ss @@ -1,6 +1,6 @@ (module param mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") "sig.ss" "cmdline.ss" "viewer.ss") @@ -10,9 +10,9 @@ (define current-slideshow-linker (make-parameter (lambda (core@) - (compound-unit/sig + (compound-unit (import) - (link [CONFIG : cmdline^ (cmdline@)] - [CORE : core^ (core@ (CONFIG : config^) VIEWER)] - [VIEWER : viewer^ (viewer@ CONFIG CORE)]) - (export (open CORE) (unit (CONFIG : config^) config) (unit VIEWER viewer))))))) + (export CORE CMDLINE VIEWER) + (link [((CONFIG : config^) (CMDLINE : cmdline^)) cmdline@] + [((CORE : core^)) core@ CMDLINE VIEWER] + [((VIEWER : viewer^)) viewer@ CMDLINE CORE])))))) diff --git a/collects/slideshow/sig.ss b/collects/slideshow/sig.ss index 4945822e90..861e6abf59 100644 --- a/collects/slideshow/sig.ss +++ b/collects/slideshow/sig.ss @@ -1,6 +1,6 @@ (module sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide config^ viewer^ core^ cmdline^) @@ -81,9 +81,8 @@ ;; ---------------------------------------- ;; Extra cmdline inputs to a viewer: - (define-signature cmdline^ - ((open config^) - file-to-load ; #f or a path/string + (define-signature cmdline^ extends config^ + (file-to-load ; #f or a path/string init-page use-transitions? print-slide-seconds? diff --git a/collects/slideshow/slide.ss b/collects/slideshow/slide.ss index 7697030c4b..c28bd532e5 100644 --- a/collects/slideshow/slide.ss +++ b/collects/slideshow/slide.ss @@ -1,6 +1,6 @@ (module slide mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "contract.ss") (lib "mrpict.ss" "texpict") (lib "utils.ss" "texpict") @@ -19,10 +19,11 @@ ;; "slides-to-picts.ss". Such namespace games are not necessary if ;; talks are written as units and linked to the core.ss unit. - (define-values/invoke-unit/sig ((open core^) - (unit config : config^) - (unit viewer : viewer^)) - ((current-slideshow-linker) core@)) + (define-values/invoke-unit ((current-slideshow-linker) core@) + (import) + (export core^ + (prefix config: config^) + (prefix viewer: viewer^))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Contracts ;; diff --git a/collects/slideshow/slides-to-picts.ss b/collects/slideshow/slides-to-picts.ss index 0d73f0af96..ed43e995f9 100644 --- a/collects/slideshow/slides-to-picts.ss +++ b/collects/slideshow/slides-to-picts.ss @@ -2,7 +2,7 @@ (module slides-to-picts mzscheme (require (lib "mred.ss" "mred") (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "etc.ss") "sig.ss" "param.ss" @@ -26,40 +26,42 @@ (namespace-attach-module orig-ns core)) (current-slideshow-linker (lambda (core@) - (compound-unit/sig + (compound-unit (import) - (link [CONFIG : config^ ((unit/sig config^ - (import) - (define base-font-size 32) - (define screen-w 1024) - (define screen-h 768) - (define use-screen-w w) - (define use-screen-h h) - (define pixel-scale 1) - (define condense? c?) - (define printing? #f) - (define smoothing? #t) - (define commentary-on-slide? #f)))] - [CORE : core^ (core@ CONFIG (VIEWER : viewer^))] - [VIEWER : viewer^ ((unit/sig viewer^ - (import) - (define (add-talk-slide! s) - (set! slides (cons s slides)) - (when (and stop-after - ((length slides) . >= . stop-after)) - (escape (void)))) - (define (retract-talk-slide!) - (set! slides (cdr slides))) - (define (most-recent-talk-slide) - (and (pair? slides) (car slides))) - (define display-progress void) - (define set-init-page! void) - (define set-use-background-frame! void) - (define enable-click-advance! void) - (define set-page-numbers-visible! void) - (define add-click-region! void) - (define done-making-slides void)))]) - (export (open CORE) (unit CONFIG config) (unit VIEWER viewer))))) + (export CORE CONFIG VIEWER) + (link [((CONFIG : config^)) (unit + (import) + (export config^) + (define base-font-size 32) + (define screen-w 1024) + (define screen-h 768) + (define use-screen-w w) + (define use-screen-h h) + (define pixel-scale 1) + (define condense? c?) + (define printing? #f) + (define smoothing? #t) + (define commentary-on-slide? #f))] + [((CORE : core^)) core@ CONFIG VIEWER] + [((VIEWER : viewer^)) (unit + (import) + (export viewer^) + (define (add-talk-slide! s) + (set! slides (cons s slides)) + (when (and stop-after + ((length slides) . >= . stop-after)) + (escape (void)))) + (define (retract-talk-slide!) + (set! slides (cdr slides))) + (define (most-recent-talk-slide) + (and (pair? slides) (car slides))) + (define display-progress void) + (define set-init-page! void) + (define set-use-background-frame! void) + (define enable-click-advance! void) + (define set-page-numbers-visible! void) + (define add-click-region! void) + (define done-making-slides void))])))) (parameterize ([current-namespace ns]) (let/ec k (set! escape k) diff --git a/collects/slideshow/tool.ss b/collects/slideshow/tool.ss index 050111121d..fa8b07671d 100644 --- a/collects/slideshow/tool.ss +++ b/collects/slideshow/tool.ss @@ -25,7 +25,7 @@ pict snip : (require (lib "tool.ss" "drscheme") (lib "mred.ss" "mred") (lib "class.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "contract.ss") (lib "string-constant.ss" "string-constants") (lib "framework.ss" "framework") @@ -52,9 +52,9 @@ pict snip : #f))])) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define original-output-port (current-output-port)) (define (oprintf . args) (apply fprintf original-output-port args)) diff --git a/collects/slideshow/viewer.ss b/collects/slideshow/viewer.ss index 5e4af6c996..dd3484acab 100644 --- a/collects/slideshow/viewer.ss +++ b/collects/slideshow/viewer.ss @@ -2,7 +2,6 @@ (module viewer mzscheme (require (lib "class.ss") (lib "unit.ss") - (lib "unitsig.ss") (lib "file.ss") (lib "etc.ss") (lib "contract.ss") @@ -21,14 +20,14 @@ ;; Needed for browsing (define original-security-guard (current-security-guard)) - (define viewer@ - (unit/sig viewer^ - (import (config : cmdline^) core^) - (rename (viewer:set-use-background-frame! set-use-background-frame!) - (viewer:enable-click-advance! enable-click-advance!) - (viewer:set-page-numbers-visible! set-page-numbers-visible!) - (viewer:done-making-slides done-making-slides)) - + (define-unit viewer@ + (import (prefix config: cmdline^) core^) + (export (rename viewer^ + (viewer:set-use-background-frame! set-use-background-frame!) + (viewer:enable-click-advance! enable-click-advance!) + (viewer:set-page-numbers-visible! set-page-numbers-visible!) + (viewer:done-making-slides done-making-slides))) + (define-accessor margin get-margin) (define-accessor client-w get-client-w) (define-accessor client-h get-client-h) @@ -1158,4 +1157,4 @@ (send f-both show #f)) (when background-f (send background-f show #f)) - (eh exn))))))) + (eh exn)))))) diff --git a/collects/stepper/private/annotate.ss b/collects/stepper/private/annotate.ss index 51ab094a7f..760f634892 100644 --- a/collects/stepper/private/annotate.ss +++ b/collects/stepper/private/annotate.ss @@ -862,6 +862,10 @@ (wcm-pre-break-wrap debug-info begin-form)) free-vars-all))])) + ;; temporary hack for ProfJ stepper, 2006-12-4, JBC + [(begin0 first-body . bodies-stx) + #`(error "shouldn't get evaluated, please.\n")] + #;[(begin0 first-body . bodies-stx) (let*-2vals ([(annotated-first free-vars-first) (result-recur first-body)]) #`(let ([,begin0-temp #,annotated-first]) diff --git a/collects/stepper/private/marks.ss b/collects/stepper/private/marks.ss index 5217bb2103..591fe6f752 100644 --- a/collects/stepper/private/marks.ss +++ b/collects/stepper/private/marks.ss @@ -77,9 +77,8 @@ (define (mark-source mark) (full-mark-struct-source (mark))) - ; : identifier -> identifier (define (make-mark-binding-stx id) - #`(lambda () #,(stepper-syntax-property id 'stepper-dont-check-for-function #t))) + #`(lambda () #,id)) (define (mark-bindings mark) (map list diff --git a/collects/stepper/private/model-settings.ss b/collects/stepper/private/model-settings.ss index 3a7f2ff6e9..f4d8fb36ce 100644 --- a/collects/stepper/private/model-settings.ss +++ b/collects/stepper/private/model-settings.ss @@ -29,6 +29,7 @@ [lifting? boolean?])] + [get-render-settings ((any/c . -> . string?) ; render-to-string (any/c . -> . any) ; render-to-sexp boolean? ; lifting? diff --git a/collects/stepper/private/shared.ss b/collects/stepper/private/shared.ss index 056a9be429..e8797cba5d 100644 --- a/collects/stepper/private/shared.ss +++ b/collects/stepper/private/shared.ss @@ -91,7 +91,14 @@ finished-xml-box-table language-level->name - stepper-syntax-property) + stepper-syntax-property + + skipto/cdr + skipto/cddr + skipto/first + skipto/second + skipto/third + skipto/fourth) ;; stepper-syntax-property : like syntax property, but adds properties to an association @@ -402,20 +409,22 @@ (define second-arg (lambda (dc y) y)) (define (up-mapping traversal fn) + (unless (symbol? fn) + (error 'up-mapping "expected symbol for stepper traversal, given: ~v" fn)) (case traversal [(rebuild) (case fn [(car) (lambda (stx new) (cons new (cdr stx)))] [(cdr) (lambda (stx new) (cons (car stx) new))] [(syntax-e) (swap-args rebuild-stx)] [(both-l both-r) (lambda (stx a b) (cons a b))] - [else (error 'up-mapping "unexpected symbol in up-mapping (1)")])] + [else (error 'up-mapping "unexpected symbol in up-mapping (1): ~v" fn)])] [(discard) (case fn [(car) second-arg] [(cdr) second-arg] [(syntax-e) second-arg] [(both-l) (lambda (stx a b) a)] [(both-r) (lambda (stx a b) b)] - [else (error 'up-mapping "unexpected symbol in up-mapping (2)")])])) + [else (error 'up-mapping "unexpected symbol in up-mapping (2): ~v" fn)])])) (define (down-mapping fn) (case fn @@ -435,6 +444,14 @@ [else (let ([down (down-mapping (car fn-list))]) (up val (update (cdr fn-list) (down val) fn traversal)))])))) + ;; commonly used patterns: + (define skipto/cdr `(syntax-e cdr)) + (define skipto/cddr `(syntax-e cdr cdr)) + (define skipto/first `(syntax-e car)) + (define skipto/second `(syntax-e cdr car)) + (define skipto/third `(syntax-e cdr cdr car)) + (define skipto/fourth `(syntax-e cdr cdr cdr car)) + #;(display (equal? (update '(cdr cdr car both-l (car) (cdr)) `(a . (b ((1) c . 2) d)) (lambda (x) (+ x 1)) diff --git a/collects/stepper/stepper+xml-tool.ss b/collects/stepper/stepper+xml-tool.ss index babc1726b6..b626083b55 100644 --- a/collects/stepper/stepper+xml-tool.ss +++ b/collects/stepper/stepper+xml-tool.ss @@ -1,5 +1,5 @@ (module stepper+xml-tool mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "tool.ss" "drscheme") "stepper-tool.ss" "xml-tool.ss") @@ -15,9 +15,8 @@ ;; stepper-tool phase1 is the non-void one. -- JBC, 2006-09-28 (define tool@ - (compound-unit/sig - (import (TOOL-IMPORTS : drscheme:tool^)) - (link (XML-TOOL : (xml-snip% scheme-snip%) (xml-tool@ TOOL-IMPORTS)) - (STEPPER-TOOL : drscheme:tool-exports^ - (stepper-tool@ TOOL-IMPORTS XML-TOOL))) - (export (open STEPPER-TOOL))))) + (compound-unit/infer + (import drscheme:tool^) + (export STEPPER-TOOL) + (link xml-tool@ + (((STEPPER-TOOL : drscheme:tool-exports^)) stepper-tool@))))) diff --git a/collects/stepper/stepper-tool.ss b/collects/stepper/stepper-tool.ss index 0292e41cd3..12a72132b8 100644 --- a/collects/stepper/stepper-tool.ss +++ b/collects/stepper/stepper-tool.ss @@ -7,7 +7,7 @@ (lib "string-constant.ss" "string-constants") (lib "async-channel.ss") (prefix frame: (lib "framework.ss" "framework")) - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "list.ss") (prefix model: "private/model.ss") @@ -15,7 +15,8 @@ (prefix x: "private/mred-extensions.ss") "private/shared.ss" "private/model-settings.ss" - "stepper-language-interface.ss") + "stepper-language-interface.ss" + "xml-sig.ss") ;; hidden invariant: this list should be a sublist of the language-level ;; dialog (i.e., same order): @@ -29,9 +30,9 @@ (provide stepper-tool@) - (define stepper-tool@ - (unit/sig drscheme:tool-exports^ - (import drscheme:tool^ (xml-snip% scheme-snip%)) + (define-unit stepper-tool@ + (import drscheme:tool^ xml^) + (export drscheme:tool-exports^) ;; tool magic here: (define (phase1) @@ -683,4 +684,4 @@ (drscheme:get/extend:extend-definitions-text stepper-definitions-text-mixin) - ))) + )) diff --git a/collects/stepper/xml-sig.ss b/collects/stepper/xml-sig.ss new file mode 100644 index 0000000000..7c87c42b5c --- /dev/null +++ b/collects/stepper/xml-sig.ss @@ -0,0 +1,2 @@ +(module xml-sig (lib "a-signature.ss") + xml-snip% scheme-snip%) \ No newline at end of file diff --git a/collects/stepper/xml-tool.ss b/collects/stepper/xml-tool.ss index e5d18d30c2..c1384b67a2 100644 --- a/collects/stepper/xml-tool.ss +++ b/collects/stepper/xml-tool.ss @@ -1,7 +1,8 @@ (module xml-tool mzscheme (require "private/xml-snip-helpers.ss" - (lib "unitsig.ss") + "xml-sig.ss" + (lib "unit.ss") (lib "contract.ss") (lib "class.ss") (lib "mred.ss" "mred") @@ -13,10 +14,9 @@ (provide xml-tool@) (define orig (current-output-port)) - (define xml-tool@ - (unit/sig (xml-snip% scheme-snip%) - (import drscheme:tool^) - + (define-unit xml-tool@ + (import drscheme:tool^) + (export xml^) (define (phase1) (void)) (define (phase2) (void)) @@ -424,4 +424,4 @@ (drscheme:language:register-capability 'drscheme:special:xml-menus (flat-contract boolean?) #t) - (drscheme:get/extend:extend-unit-frame xml-box-frame-extension)))) + (drscheme:get/extend:extend-unit-frame xml-box-frame-extension))) diff --git a/collects/swindle/tool.ss b/collects/swindle/tool.ss index 2a074f53a5..00318cf399 100644 --- a/collects/swindle/tool.ss +++ b/collects/swindle/tool.ss @@ -2,7 +2,7 @@ ;; This allows adding a Swindle icon on startup. (module tool mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "tool.ss" "drscheme") (lib "class.ss") (lib "list.ss") @@ -11,7 +11,7 @@ (lib "string-constant.ss" "string-constants")) (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ (import drscheme:tool^) + (unit (import drscheme:tool^) (export drscheme:tool-exports^) ;; Swindle languages (define (swindle-language module* name* entry-name* num* one-line* url*) (class (drscheme:language:module-based-language->language-mixin diff --git a/collects/syntax/zodiac-sig.ss b/collects/syntax/zodiac-sig.ss index a6d73c618b..77c270f25f 100644 --- a/collects/syntax/zodiac-sig.ss +++ b/collects/syntax/zodiac-sig.ss @@ -3,13 +3,8 @@ ;; for programs that used to manipulate the ;; output of zodiac elaboration. -(module zodiac-sig mzscheme - (require (lib "unitsig.ss")) - - (provide zodiac^) - - (define-signature zodiac^ - (;; Syntax -> zodiac compatibility: +(module zodiac-sig (lib "a-signature.ss") + ;; Syntax -> zodiac compatibility: syntax->zodiac ;; Zodiac compatibility -> syntax: zodiac->syntax @@ -110,4 +105,5 @@ (struct ilist-arglist ()) make-empty-back-box - register-client))) + register-client) + diff --git a/collects/syntax/zodiac-unit.ss b/collects/syntax/zodiac-unit.ss index 3159c1b6a7..f8b5e3dcda 100644 --- a/collects/syntax/zodiac-unit.ss +++ b/collects/syntax/zodiac-unit.ss @@ -2,19 +2,15 @@ ;; for programs that used to manipulate the ;; output of zodiac elaboration. -(module zodiac-unit mzscheme - (require (lib "unitsig.ss") - (lib "list.ss")) - (require "kerncase.ss") - - (require "zodiac-sig.ss" +(module zodiac-unit (lib "a-unit.ss") + (require (lib "unit.ss") + (lib "list.ss") + "kerncase.ss" + "zodiac-sig.ss" "stx.ss") - (provide zodiac@) - - (define zodiac@ - (unit/sig zodiac^ (import) + (export zodiac^) (define (stx-bound-assq ssym l) (ormap (lambda (p) @@ -784,4 +780,4 @@ (define-struct arglist (vars)) (define-struct (sym-arglist arglist) ()) (define-struct (list-arglist arglist) ()) - (define-struct (ilist-arglist arglist) ())))) + (define-struct (ilist-arglist arglist) ())) diff --git a/collects/syntax/zodiac.ss b/collects/syntax/zodiac.ss index f08f4ee3f1..b23a1571f0 100644 --- a/collects/syntax/zodiac.ss +++ b/collects/syntax/zodiac.ss @@ -1,11 +1,10 @@ (module zodiac mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "zodiac-sig.ss") (require "zodiac-unit.ss") - (define-values/invoke-unit/sig zodiac^ - zodiac@) + (define-values/invoke-unit/infer zodiac@) (provide-signature-elements zodiac^)) diff --git a/collects/test-suite/private/print-to-text.ss b/collects/test-suite/private/print-to-text.ss index 5a4f2f7f45..61953ef031 100644 --- a/collects/test-suite/private/print-to-text.ss +++ b/collects/test-suite/private/print-to-text.ss @@ -5,7 +5,7 @@ (lib "etc.ss") (lib "class.ss") (lib "contract.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "mred.ss" "mred") (lib "framework.ss" "framework") (lib "tool.ss" "drscheme")) @@ -16,10 +16,10 @@ (define-signature print-to-text^ (print-to-text)) - (define print-to-text@ - (unit/sig print-to-text^ + (define-unit print-to-text@ + (import drscheme:tool^) - + (export print-to-text^) ;; Using the current languages print operations, print the list of values to the text (define (print-to-text atext vals) (unless (empty? vals) @@ -59,4 +59,4 @@ (newline port) (print-one val)) (rest vals))) - (send atext end-edit-sequence)))))) + (send atext end-edit-sequence))))) diff --git a/collects/test-suite/private/test-case-box.ss b/collects/test-suite/private/test-case-box.ss index 2dec7d1708..313609810c 100644 --- a/collects/test-suite/private/test-case-box.ss +++ b/collects/test-suite/private/test-case-box.ss @@ -10,7 +10,7 @@ (lib "class.ss") (lib "list.ss") (lib "mred.ss" "mred") - (lib "unitsig.ss") + (lib "unit.ss") (lib "tool.ss" "drscheme") (lib "etc.ss") (lib "match.ss") @@ -18,6 +18,7 @@ (lib "readerr.ss" "syntax") (lib "string-constant.ss" "string-constants") (lib "embedded-gui.ss" "embedded-gui") + (lib "shared.ss" "stepper" "private") "make-snipclass.ss" "convert-to-string.ss" "text-syntax-object.ss" @@ -25,11 +26,10 @@ "test-case.ss" (only (lib "teachprims.ss" "lang" "private") beginner-equal?)) - (define-signature test-case-box^ (test-case-box% phase1 phase2)) - (define test-case-box@ - (unit/sig test-case-box^ - (import drscheme:tool^ text->syntax-object^ print-to-text^) - + (define-signature test-case-box^ extends drscheme:tool-exports^ (test-case-box%)) + (define-unit test-case-box@ + (import drscheme:tool^ text->syntax-object^ print-to-text^) + (export test-case-box^) (define test-case:program-editor% false) (define (phase1) (void)) @@ -88,9 +88,9 @@ (syntax-span next))])) (syntax-property (if enabled? - (with-syntax ([to-test-stx (syntax-property (text->syntax-object to-test #f) - 'stepper-test-suite-hint - true)] + (with-syntax ([to-test-stx (stepper-syntax-property (text->syntax-object to-test #f) + 'stepper-test-suite-hint + true)] [update-stx (lambda (x) (update x))] ; eta public method [set-actuals-stx set-actuals] [w printf]) @@ -120,9 +120,9 @@ exp-stx update-stx set-actuals-stx))))) - (syntax-property #'(define-values () (values)) - 'stepper-skip-completely - true)) + (stepper-syntax-property #'(define-values () (values)) + 'stepper-skip-completely + true)) 'test-case-box #t))) #;(boolean? . -> . void?) @@ -477,7 +477,7 @@ (predicate predicate) (should-raise should-raise) (error-message error-message)))))) - )) + ) #;((-> void?) (-> void?) (symbols 'up 'down) . -> . snip%) ;; a snip which acts as a toggle button for rolling a window up and down diff --git a/collects/test-suite/private/test-case.ss b/collects/test-suite/private/test-case.ss index 30cec55a0d..2ad1aca124 100644 --- a/collects/test-suite/private/test-case.ss +++ b/collects/test-suite/private/test-case.ss @@ -7,6 +7,7 @@ to give better error messages when the test-case is not at the top level. (module test-case mzscheme + (require-for-syntax (lib "shared.ss" "stepper" "private")) (provide test-case test-error-case) ;; STATUS : Abstract these two syntaxes and use string constant for the error @@ -15,30 +16,32 @@ to give better error messages when the test-case is not at the top level. [(_ test to-test-stx exp-stx record set-actuals) (case (syntax-local-context) [(module top-level) - (syntax-property + (stepper-syntax-property #`(define-values () (let ([to-test-values (call-with-values - (lambda () #,(syntax-property #`to-test-stx - 'stepper-test-suite-hint - #t)) - list)] + (lambda () #,(stepper-syntax-property #`to-test-stx + 'stepper-test-suite-hint + #t)) + list)] [exp-values (call-with-values (lambda () exp-stx) list)]) (record (and (= (length to-test-values) (length exp-values)) (andmap test to-test-values exp-values))) (set-actuals to-test-values) (values))) 'stepper-skipto - (list ;define-values - syntax-e cdr cdr car - ; let-values - syntax-e cdr car - ; clauses - syntax-e car syntax-e cdr car - ; call-with-values - syntax-e cdr syntax-e cdr car - ; lambda - syntax-e cdr cdr car - ))] + (append + ;; define-values->body + skipto/third + ;; rhs of first binding of let-values: + skipto/second + skipto/first + skipto/second + ;; 2nd arg of call-with-values application: + skipto/cdr + skipto/second + ;; first (only) body of lambda: + skipto/cddr + skipto/first))] [else (raise-syntax-error #f "test case not at toplevel" (syntax/loc stx (test-case to-test-stx exp-stx)))])])) @@ -48,7 +51,7 @@ to give better error messages when the test-case is not at the top level. [(_ to-test-stx exn-pred exn-handler record set-actuals) (case (syntax-local-context) [(module top-level) - (syntax-property + (stepper-syntax-property #'(define-values () (with-handlers ([exn-pred (lambda (v) @@ -64,11 +67,10 @@ to give better error messages when the test-case is not at the top level. (record #f) (values))) 'stepper-skipto - (list ;; define-values - syntax-e cdr cdr car - ;; with-handlers - syntax-e cdr cdr cdr car - ))] + `(,@skipto/third + ;; with-handlers: + ,@skipto/fourth + ))] [else (raise-syntax-error #f "test case not at toplevel" (syntax/loc stx (test-case to-test-stx exp-stx)))])])) diff --git a/collects/test-suite/private/text-syntax-object.ss b/collects/test-suite/private/text-syntax-object.ss index cf33146618..c1139893e9 100644 --- a/collects/test-suite/private/text-syntax-object.ss +++ b/collects/test-suite/private/text-syntax-object.ss @@ -1,7 +1,7 @@ (module text-syntax-object mzscheme (require - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "list.ss") (lib "tool.ss" "drscheme") @@ -15,10 +15,10 @@ (define-signature text->syntax-object^ (text->syntax-objects)) - (define text->syntax-object@ - (unit/sig text->syntax-object^ - (import drscheme:tool^) - + (define-unit text->syntax-object@ + + (import drscheme:tool^) + (export text->syntax-object^) #;((is-a?/c text%) . -> . (listof syntax-object?)) ;; a syntax object representing the text with the color of the given object (define (text->syntax-objects text default-v) @@ -56,4 +56,4 @@ (error 'text->syntax-object "Invalid language settings")))) (read-all-syntax))) )) - ) \ No newline at end of file + diff --git a/collects/test-suite/tool.ss b/collects/test-suite/tool.ss index 399313bcbb..4b5dac57b0 100644 --- a/collects/test-suite/tool.ss +++ b/collects/test-suite/tool.ss @@ -6,7 +6,7 @@ (lib "etc.ss") (lib "class.ss") (lib "mred.ss" "mred") - (lib "unitsig.ss") + (lib "unit.ss") (lib "tool.ss" "drscheme") (lib "framework.ss" "framework") (lib "string-constant.ss" "string-constants") @@ -17,10 +17,10 @@ "private/print-to-text.ss") (define-signature menu-extentions^ ()) - (define menu-extentions@ - (unit/sig menu-extentions^;drscheme:tool-exports^ - (import drscheme:tool^ test-case-box^) - + (define-unit menu-extentions@ + (import drscheme:tool^ test-case-box^) + (export menu-extentions^;drscheme:tool-exports^ + ) ;; This delay is set up because reset-highlighting is called immediately ;; after execution where I don't want the test-cases to be cleared. ;; STATUS: It appears that the problem this flag was created to fix has been @@ -165,15 +165,11 @@ (namespace-require '(lib "test-case.ss" "test-suite" "private")))) (super-new))) - (drscheme:get/extend:extend-interactions-text require-macro-mixin))) + (drscheme:get/extend:extend-interactions-text require-macro-mixin)) (define tool@ - (compound-unit/sig - (import (TOOL : drscheme:tool^)) - (link (MENU : menu-extentions^ (menu-extentions@ TOOL CASE)) - (CASE : test-case-box^ (test-case-box@ TOOL SYNTAX PRINT)) - (SYNTAX : text->syntax-object^ (text->syntax-object@ TOOL)) - (PRINT : print-to-text^ (print-to-text@ TOOL))) - (export (var (CASE phase1)) - (var (CASE phase2))))) + (compound-unit/infer + (import drscheme:tool^) + (export drscheme:tool-exports^) + (link menu-extentions@ test-case-box@ text->syntax-object@ print-to-text@))) ) diff --git a/collects/tests/drscheme/tool.ss b/collects/tests/drscheme/tool.ss index d7634ca57c..83e61ff87e 100644 --- a/collects/tests/drscheme/tool.ss +++ b/collects/tests/drscheme/tool.ss @@ -3,7 +3,7 @@ (module tool mzscheme (require (lib "tool.ss" "drscheme") (lib "list.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "mred.ss" "mred") (lib "framework.ss" "framework")) @@ -11,9 +11,9 @@ (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) diff --git a/collects/tests/mzscheme/contmark.ss b/collects/tests/mzscheme/contmark.ss index 03f789967c..d56b9bfad8 100644 --- a/collects/tests/mzscheme/contmark.ss +++ b/collects/tests/mzscheme/contmark.ss @@ -2,7 +2,7 @@ (load-relative "loadtest.ss") -(require (lib "unit.ss")) +(require (lib "unit200.ss")) (Section 'continuation-marks) diff --git a/collects/tests/mzscheme/name.ss b/collects/tests/mzscheme/name.ss index 3c8485c932..aa2c304bb0 100644 --- a/collects/tests/mzscheme/name.ss +++ b/collects/tests/mzscheme/name.ss @@ -4,7 +4,7 @@ (load-relative "loadtest.ss") (require (lib "class.ss")) -(require (lib "unit.ss")) +(require (lib "unit200.ss")) (Section 'names) diff --git a/collects/tests/mzscheme/pconvert.ss b/collects/tests/mzscheme/pconvert.ss index 5e95c4a159..b283fdae44 100644 --- a/collects/tests/mzscheme/pconvert.ss +++ b/collects/tests/mzscheme/pconvert.ss @@ -3,8 +3,7 @@ (Section 'pconvert) -(require (lib "unit.ss") - (lib "file.ss") +(require (lib "file.ss") (lib "class.ss") (lib "pconvert.ss")) @@ -12,7 +11,6 @@ (quasi-read-style-printing #f) (define (xl) 1) -(define (xu) (unit (import) (export))) (define (xc) (class object% () (sequence (super-init)))) (let () @@ -174,7 +172,6 @@ (make-pctest null 'empty 'empty 'empty '`() '`() '`() 'empty) (make-same-test add1 'add1) (make-same-test (void) '(void)) - (make-same-test (unit (import) (export)) '(unit ...)) (make-same-test (make-weak-box 12) '(make-weak-box 12)) (make-same-test (regexp "1") '(regexp "1")) (make-same-test (module-path-index-join #f #f) '(module-path-index-join false false)) @@ -190,12 +187,6 @@ (make-same-test (letrec ([xc-ID-BETTER-NOT-BE-DEFINED (class object% ())]) xc-ID-BETTER-NOT-BE-DEFINED) '(class ...)) - (make-same-test xu 'xu) - (make-same-test (letrec ([xu (unit (import) (export))]) xu) - '(unit ...)) - (make-same-test (letrec ([xu-ID-BETTER-NOT-BE-DEFINED (unit (import) (export))]) - xu-ID-BETTER-NOT-BE-DEFINED) - '(unit ...)) (make-same-test (lambda (x) x) '(lambda (a1) ...)) (make-same-test (lambda x x) '(lambda args ...)) (make-same-test (lambda (a b . c) a) '(lambda (a1 a2 . args) ...)) @@ -360,7 +351,6 @@ (test-shared (lambda (x) x) '(lambda (a1) ...)) (test-shared (delay 1) '(delay ...)) (test-shared (class object% ()) '(class ...)) - (test-shared (unit (import) (export)) '(unit ...)) (test-shared (new (class object% (super-new))) '(instantiate (class ...) ...)) (test-shared "abc" "abc") diff --git a/collects/tests/mzscheme/unit.ss b/collects/tests/mzscheme/unit.ss index 337e165177..67b6c2a257 100644 --- a/collects/tests/mzscheme/unit.ss +++ b/collects/tests/mzscheme/unit.ss @@ -2,7 +2,7 @@ (load-relative "loadtest.ss") (Section 'unit) -(require (lib "unit.ss")) +(require (lib "unit200.ss")) (syntax-test #'(unit)) (syntax-test #'(unit (import))) diff --git a/collects/tests/mzscheme/unitsig.ss b/collects/tests/mzscheme/unitsig.ss index 2de5947459..c0e03b5830 100644 --- a/collects/tests/mzscheme/unitsig.ss +++ b/collects/tests/mzscheme/unitsig.ss @@ -1,8 +1,8 @@ (load-relative "loadtest.ss") -(require (lib "unit.ss")) -(require (lib "unitsig.ss")) +(require (lib "unit200.ss")) +(require (lib "unitsig200.ss")) (require (lib "include.ss")) (Section 'unit/sig) diff --git a/collects/tests/stepper/through-tests.ss b/collects/tests/stepper/through-tests.ss index dcdcf700cb..d58bfc4c50 100755 --- a/collects/tests/stepper/through-tests.ss +++ b/collects/tests/stepper/through-tests.ss @@ -290,7 +290,7 @@ exec mred -u "$0" "$@" :: {(for-each (lambda (x) x) `(1 2 3))} -> (... {1} ...) :: ... -> (... {2} ...) :: ... -> (... {3} ...) - :: ... -> {3}) + :: ... -> {(void)}) ;; new test case language: ;; an expected is (listof step) @@ -1480,7 +1480,7 @@ exec mred -u "$0" "$@" (t1 empty-begin (test-advanced-sequence "(begin)" - `(error "begin: expected a sequence of expressions after `begin', but nothing's there"))) + `((error "begin: expected a sequence of expressions after `begin', but nothing's there")))) ;;;;;;;;;;;; ;; @@ -1490,8 +1490,7 @@ exec mred -u "$0" "$@" (t1 empty-begin0 (test-advanced-sequence "(begin0)" - `((before-error-step ((hilite (begin0))) - "begin0: expected a sequence of expressions after `begin0', but nothing's there")))) + `((error "begin0: expected a sequence of expressions after `begin0', but nothing's there")))) (t1 trivial-begin0 (test-advanced-sequence "(begin0 3)" @@ -1561,7 +1560,7 @@ exec mred -u "$0" "$@" "(define (f2c x) x) (convert-gui f2c)" `() ; placeholder )) - #;(run-tests '(begin0-onlyvalues)) + #;(run-tests '(mz1 empty-begin empty-begin0)) (run-all-tests) ) diff --git a/collects/tests/units/multi-mod-sigs.ss b/collects/tests/units/multi-mod-sigs.ss new file mode 100644 index 0000000000..147804e495 --- /dev/null +++ b/collects/tests/units/multi-mod-sigs.ss @@ -0,0 +1,55 @@ +(module test1 mzscheme + (require (lib "unit.ss")) + (provide s1) + (define-signature s1 + ((define-values (a) (+ 1 b)) + b))) + +(module test2 mzscheme + (require (lib "unit.ss") test1) + (provide s2) + (define-signature s2 extends s1 + ((define-values (c) (list b a d)) + d))) + +(module test3 mzscheme + (require (lib "unit.ss") test1 test2) + (provide (all-defined)) + (define-unit u1 (import s1) (export) + (list a b)) + (define-unit u2 (import s2) (export) + (list a b c d)) + (define-unit u3 (import) (export s1) + (define b 100)) + (define-unit u4 (import) (export s2) + (define b 1000) + (define d 10000))) + + +(module test4 mzscheme + (require (lib "unit.ss") test1 test2 test3) + (require "test-harness.ss") + (test '(101 100) + (invoke-unit + (compound-unit/infer (import) (export s1) (link u3 u1)))) + + (test '(1001 1000) + (invoke-unit + (compound-unit/infer (import) (export s1) (link u4 u1)))) + + (test '(1001 1000) + (invoke-unit + (compound-unit/infer (import) (export s2) (link u4 u1)))) + + (test '(1001 1000 (1000 1001 10000) 10000) + (invoke-unit + (compound-unit/infer (import) (export s1) (link u4 u2)))) + + (test '(1001 1000 (1000 1001 10000) 10000) + (invoke-unit + (compound-unit/infer (import) (export s2) (link u4 u2)))) + + + ) + +(require test4) \ No newline at end of file diff --git a/collects/tests/units/test-cert.ss b/collects/tests/units/test-cert.ss new file mode 100644 index 0000000000..8c36734e10 --- /dev/null +++ b/collects/tests/units/test-cert.ss @@ -0,0 +1,39 @@ +(module test mzscheme + (require (lib "unit.ss")) + + (provide s) + + (define x add1) + + (define-signature s + (a + (define-values (y) (x a)) + (define-syntaxes (z) + (syntax-rules () ((_) (x a))))))) + + (module test2 mzscheme + (require (lib "unit.ss") + test) + (define-unit u1 (import) (export s) + (define a 1)) + (define-unit u2 (import s) (export) + (+ y (z))) + (define-compound-unit u3 (import) (export) + (link (((S : s)) u1) + (() u2 S))) + (printf "~a~n" (invoke-unit u3)) + ) + + ;; 4 + (require test2) + + (module test3 mzscheme + (require (lib "unit.ss") + test) + (define-unit u1 (import) (export s) + (define a 1)) + (define-values/invoke-unit u1 (import) (export (rename s))) + (printf "~a~n" (+ y (z))) + ) + ;;4 + (require test3) \ No newline at end of file diff --git a/collects/tests/units/test-exptime.ss b/collects/tests/units/test-exptime.ss new file mode 100644 index 0000000000..7366519bfb --- /dev/null +++ b/collects/tests/units/test-exptime.ss @@ -0,0 +1,43 @@ +(require-for-syntax (lib "unit-exptime.ss")) +(require "test-harness.ss" + ;unit + (lib "unit.ss")) + +(define-signature one^ (one-a one-b)) +(define-signature two^ (two-a + (define-values (two-v1 two-v2) (values 1 2)) + (define-syntaxes (m) (syntax-rules () [(_) two-v2])))) +(define-signature three^ ()) +(define-signature four^ extends two^ (four-z)) + +(define-unit one@ + (import one^ three^) + (export two^) + (define two-a 10)) + +(define-unit two@ + (import (tag Four four^)) + (export (tag One one^)) + (define one-a 10) + (define one-b 20)) + +(define-syntax (unit-info stx) + (syntax-case stx () + [(_ id k) (let-values ([(ins out) + (unit-static-signatures #'id stx)]) + #`(k (#,ins #,out)))])) + +(define-syntax (sig-info stx) + (syntax-case stx () + [(_ id k) (let-values ([(super vars def-vars def-macs) + (signature-members #'id stx)]) + #`(k (#,super #,vars #,def-vars #,def-macs)))])) + +(test '(#f (one-a one-b) () ()) (sig-info one^ quote)) +(test '(#f (two-a) (two-v1 two-v2) (m)) (sig-info two^ quote)) +(test '(#f () () ()) (sig-info three^ quote)) +(test '(two^ (two-a four-z) (two-v1 two-v2) (m)) (sig-info four^ quote)) + +(test '(((#f . one^) (#f . three^)) ((#f . two^))) (unit-info one@ quote)) +(test '(((Four . four^)) ((One . one^))) (unit-info two@ quote)) + diff --git a/collects/tests/units/test-harness.ss b/collects/tests/units/test-harness.ss new file mode 100644 index 0000000000..3ea4bcefdc --- /dev/null +++ b/collects/tests/units/test-harness.ss @@ -0,0 +1,54 @@ +(module test-harness mzscheme + (require (lib "stx.ss" "syntax")) + + (provide (all-defined)) + + (define (lst-bound-id=? x y) + (andmap bound-identifier=? x y)) + + (define (stx-bound-id=? x y) + (cond + ((and (stx-pair? x) + (not (syntax-e (stx-car x))) + (identifier? (stx-cdr x))) + (and (identifier? y) + (not (module-identifier=? (stx-cdr x) y)))) + ((and (stx-null? x) (stx-null? y)) + #t) + ((and (stx-pair? x) (stx-pair? y)) + (and (stx-bound-id=? (stx-car x) (stx-car y)) + (stx-bound-id=? (stx-cdr x) (stx-cdr y)))) + ((and (identifier? x) (identifier? y)) + (bound-identifier=? x y)) + ((and (number? (syntax-e x)) (number? (syntax-e y))) + (= (syntax-e x) (syntax-e y))) + (else #f))) + + (define-syntax test-syntax-error + (syntax-rules () + ((_ err expr) + (with-handlers ((exn:fail:syntax? (lambda (exn) + (printf "syntax error \"~a\"~n got message \"~a\"~n~n" + err + (exn-message exn))))) + (expand #'expr) + (error 'test-syntax-error "expected syntax error \"~a\" on ~a, got none" err 'expr))))) + + (define-syntax test-runtime-error + (syntax-rules () + ((_ err-pred err expr) + (with-handlers ((err-pred (lambda (exn) + (printf "runtime error \"~a\"~n got message \"~a\"~n~n" + err + (exn-message exn))))) + expr + (error 'test-runtime-error "expected runtime error \"~a\" on ~a, got none" err 'expr))))) + + (define-syntax test + (syntax-rules () + ((_ expected-value expr) + (test equal? expected-value expr)) + ((_ cmp expected-value expr) + (let ((v expr)) + (unless (cmp expected-value v) + (error 'test "expected ~a to evaluate to ~a, got ~a" 'expr 'expected-value v))))))) \ No newline at end of file diff --git a/collects/tests/units/test-runtime.ss b/collects/tests/units/test-runtime.ss new file mode 100644 index 0000000000..03c0516777 --- /dev/null +++ b/collects/tests/units/test-runtime.ss @@ -0,0 +1,51 @@ +(require "test-harness.ss" + (lib "unit-runtime.ss" "mzlib" "private")) + +;; check-unit +(test-runtime-error exn:fail:contract? "check-unit: not a unit" + (check-unit 1 'check-unit)) + +(test (void) + (check-unit (make-unit 1 2 3 4 5) 'check-unit)) + +;; check-helper +(define sub-vector + #((a . #((t . r1) (t . r2) (t . r3))) + (a . #((#f . r1) (#f . r2) (#f . r3))))) + +(test (void) + (check-helper sub-vector #() 'check-helper #f)) + +(test (void) + (check-helper sub-vector sub-vector 'check-helper #f)) + +(test (void) + (check-helper sub-vector + #((d . #((t . r2) (t . r3)))) + 'check-helper + #f)) + +(test-runtime-error exn:fail:contract? "check-helper: missing signature" + (check-helper sub-vector + #((c . #((t . r4) (t . r1) (t . r2) (t . r3)))) + 'check-helper + #f)) +(define sub-vector2 + #((a . #((t . r5) (t . r2) (t . r3))) + (b . #((t . r1) (t . r2) (t . r3))))) + +(test (void) + (check-helper sub-vector2 sub-vector2 'check-helper #f)) + +(test (void) + (check-helper sub-vector2 + #((a . #((t . r5) (t . r2) (t . r3)))) + 'check-helper #f)) + +(test-runtime-error exn:fail:contract? "check-helper: ambiguous signature" + (check-helper sub-vector2 + #((c . #((t . r2) (t . r3)))) + 'check-helper #f)) + +;; check-deps +;;UNTESTED \ No newline at end of file diff --git a/collects/tests/units/test-unit-compiletime.ss b/collects/tests/units/test-unit-compiletime.ss new file mode 100644 index 0000000000..07b18a2cc5 --- /dev/null +++ b/collects/tests/units/test-unit-compiletime.ss @@ -0,0 +1,331 @@ +(require-for-syntax (lib "unit-compiletime.ss" "mzlib" "private") + (lib "unit-syntax.ss" "mzlib" "private")) +(require "test-harness.ss" + (lib "unit-compiletime.ss" "mzlib" "private") + (lib "unit-keywords.ss" "mzlib" "private") + (lib "unit-syntax.ss" "mzlib" "private")) + + +;; split-requires +;; UNTESTED + +;; build-siginfo + siginfo-subtype +(test #t (siginfo-subtype (make-siginfo '(n1 n2 n3) '(c1 c2 c3) (syntax->list #'(r1 r2 r3))) + (make-siginfo '(n1 n2 n3) '(c1 c2 c3) (syntax->list #'(r1 r2 r3))))) +(test #t (siginfo-subtype (make-siginfo '(n1 n2 n3) '(c1 c2 c3) (syntax->list #'(r1 r2 r3))) + (make-siginfo '(n2 n3) '(c2 c3) (syntax->list #'(r2 r3))))) +(test #f (siginfo-subtype (make-siginfo '(n2 n3) '(c2 c3) (syntax->list #'(r2 r3))) + (make-siginfo '(n1 n2 n3) '(c1 c2 c3) (syntax->list #'(r1 r2 r3))))) + + +;; signature-proc +(test-syntax-error "illegal use of signature name" + (let () + (define-syntax x (make-signature 1 2 3 4)) + x)) +(test-syntax-error "illegal use of signature name" + (let () + (define-syntax x (make-signature 1 2 3 4)) + (x 1))) + +;; signature-form-proc +(test-syntax-error "illegal use of signature form" + (let () + (define-syntax x (make-signature-form 1)) + x)) +(test-syntax-error "illegal use of signature form" + (let () + (define-syntax x (make-signature-form 1)) + (x 1))) + +;; unit-info-proc +(test '1 + (let () + (define x 1) + (define-syntax y (make-unit-info #'x null null null)) + y)) +(test 2 + (let () + (define x +) + (define-syntax y (make-unit-info #'x null null null)) + (y 1 1))) +(test-runtime-error exn:fail:contract? "not a unit" + (let () + (define x +) + (define-syntax y (make-set!-transformer (make-unit-info #'x null null null))) + (set! y 1))) + +;; lookup-signature +(define-syntax (lookup-sig-mac stx) + (parameterize ((error-syntax stx)) + (syntax-case stx () + ((_ id) + #`#,(signature-siginfo (lookup-signature #'id)))))) +(test-syntax-error "lookup-signature: not id" + (lookup-sig-mac 1)) +(test-syntax-error "lookup-signature: unbound id" + (lookup-sig-mac s)) +(test-syntax-error "lookup-signature: not a sig" + (lookup-sig-mac lookup-sig-mac)) +(let () + (define-syntax x (make-signature 1 2 3 4)) + (test 1 (lookup-sig-mac x))) + +;; process-import +(define-syntax (process-import-mac-sig stx) + (parameterize ((error-syntax stx)) + (syntax-case stx () + ((_ x) + #`#'#,(caddr (process-tagged-import #'x)))))) +(define-for-syntax si (make-siginfo '(test-sig) '(ct) (list #'rt))) +(define-syntax test-sig (make-signature si + (list #'x #'y) + (list (cons (list #'v1 #'v2) #'body1) + (cons (list #'v3 #'v4) #'body2)) + (list (cons (list #'s1 #'s2) #'body3) + (cons (list #'s3 #'s4) #'body4)))) + +(test stx-bound-id=? #'(((x . x) (y . y)) + ((((v1 . v1) (v2 . v2)) . body1) + (((v3 . v3) (v4 . v4)) . body2)) + ((((s1 . s1) (s2 . s2)) . body3) + (((s3 . s3) (s4 . s4)) . body4))) + (process-import-mac-sig test-sig)) +(let () + (define-syntax ts (make-signature 1 (list #'x) null null)) + (define x-stx #'x) + (let ((x 1)) + (test stx-bound-id=? #`(((x . #,x-stx)) () ()) + (process-import-mac-sig ts)))) +(let () + (define-syntax ts (make-signature 1 null (list (cons (list #'v1 #'v2) #'body1)) null)) + (define v2-stx #'v2) + (let ((v2 1)) + (test stx-bound-id=? #`(() ((((v1 . v1) (v2 . #,v2-stx)) . body1)) ()) + (process-import-mac-sig ts)))) +(let () + (define-syntax ts (make-signature 1 null null (list (cons (list #'s1 #'s2) #'body3)))) + (define s1-stx #'s1) + (let ((s1 1)) + (test stx-bound-id=? #`(() () ((((s1 . #,s1-stx) (s2 . s2)) . body3))) + (process-import-mac-sig ts)))) +(let ((b 1)) + (define-syntax test-sig2 (make-signature 1 null (list (cons (list #'v5) #'b)) null)) + (test stx-bound-id=? #'(() + ((((v5 . v5)) . b)) + ()) + (let ((b 1)) (process-import-mac-sig test-sig2)))) +(let ((b 2)) + (define-syntax test-sig2 (make-signature 1 null (list (cons (list #'v5) #'b)) null)) + (test stx-bound-id=? #'(() + ((((v5 . v5)) . b)) + ()) + (let ((b 3)) (process-import-mac-sig test-sig2)))) + +(test-syntax-error "process-import: only, id not in spec" + (process-import-mac (only test-sig x z))) +(test stx-bound-id=? #'(((x . x) ((#f . y) . y)) + (((((#f . v1) . v1) (v2 . v2)) . body1) + ((((#f . v3) . v3) ((#f . v4) . v4)) . body2)) + ((((s1 . s1) ((#f . s2) . s2)) . body3) + ((((#f . s3) . s3) ((#f . s4) . s4)) . body4))) + (process-import-mac-sig (only test-sig x v2 s1))) + +(test-syntax-error "process-import: except, id not in spec" + (process-import-mac (except test-sig x z))) +(test stx-bound-id=? #'(((x . x) ((#f . y) . y)) + (((((#f . v1) . v1) (v2 . v2)) . body1) + ((((#f . v3) . v3) ((#f . v4) . v4)) . body2)) + ((((s1 . s1) ((#f . s2) . s2)) . body3) + ((((#f . s3) . s3) ((#f . s4) . s4)) . body4))) + (process-import-mac-sig (except test-sig y v1 v3 v4 s2 s3 s4))) + +(test stx-bound-id=? #'(((u:x . x) (u:y . y)) + ((((u:v1 . v1) (u:v2 . v2)) . body1) + (((u:v3 . v3) (u:v4 . v4)) . body2)) + ((((u:s1 . s1) (u:s2 . s2)) . body3) + (((u:s3 . s3) (u:s4 . s4)) . body4))) + (process-import-mac-sig (prefix u: test-sig))) + +(test-syntax-error "process-import: rename clause id not in spec" + (process-import-mac (rename test-sig (z a)))) +(test-syntax-error "process-import-mac: rename clash" + (process-import-mac (rename test-sig (y x)))) +(test-syntax-error "process-import-mac: rename clash" + (process-import-mac (rename test-sig (s1 v1)))) +(test-syntax-error "process-import-mac: rename clash" + (process-import-mac (rename test-sig (x v1)))) +(test-syntax-error "process-import-mac: rename clash" + (process-import-mac (rename test-sig (v3 x)))) +(test-syntax-error "process-import-mac: rename clash" + (process-import-mac (rename test-sig (s4 x)))) +(test-syntax-error "process-import-mac: rename clash" + (process-import-mac (rename test-sig (y s3)))) +(test-syntax-error "process-import-mac: rename clash" + (process-import-mac (rename test-sig (v2 s3)))) +(test-syntax-error "process-import-mac: rename, duplicate" + (process-import-mac (rename test-sig (a x) (b x)))) +(test-syntax-error "process-import-mac: rename, duplicate" + (process-import-mac (rename test-sig (a s1) (b s1)))) +(test-syntax-error "process-import-mac: rename, duplicate" + (process-import-mac (rename test-sig (a v2) (b v2)))) +(test stx-bound-id=? #'(((x . x) (a . y)) + ((((b . v1) (v2 . v2)) . body1) + (((v3 . v3) (v4 . v4)) . body2)) + ((((s1 . s1) (c . s2)) . body3) + (((s3 . s3) (s4 . s4)) . body4))) + (process-import-mac-sig (rename test-sig (a y) (b v1) (c s2)))) + +;; process-export +(define-syntax (process-export-mac stx) + (parameterize ((error-syntax stx)) + (syntax-case stx () + ((_ x) + #`#'#,(caddr (process-tagged-export #'x)))))) + +(test-syntax-error "process-export: malformed" + (process-export-mac (x y))) +(test-syntax-error "process-export: dot" + (process-export-mac (x . y))) +(test-syntax-error "process-export: not id" + (process-export-mac 1)) +(test stx-bound-id=? #'(((x . x) (y . y)) + ((((v1 . v1) (v2 . v2)) . body1) + (((v3 . v3) (v4 . v4)) . body2)) + ((((s1 . s1) (s2 . s2)) . body3) + (((s3 . s3) (s4 . s4)) . body4))) + (process-export-mac test-sig)) +(let () + (define-syntax ts (make-signature 1 (list #'x) null null)) + (define x-stx #'x) + (let ((x 1)) + (test stx-bound-id=? #`(((x . #,x-stx)) () ()) + (process-export-mac ts)))) +(let () + (define-syntax ts (make-signature 1 null (list (cons (list #'v1 #'v2) #'body1)) null)) + (define v2-stx #'v2) + (let ((v2 1)) + (test stx-bound-id=? #`(() ((((v1 . v1) (v2 . #,v2-stx)) . body1)) ()) + (process-export-mac ts)))) +(let () + (define-syntax ts (make-signature 1 null null (list (cons (list #'s1 #'s2) #'body3)))) + (define s1-stx #'s1) + (let ((s1 1)) + (test stx-bound-id=? #`(() () ((((s1 . #,s1-stx) (s2 . s2)) . body3))) + (process-export-mac ts)))) + +(test stx-bound-id=? #'(((u:x . x) (u:y . y)) + ((((u:v1 . v1) (u:v2 . v2)) . body1) + (((u:v3 . v3) (u:v4 . v4)) . body2)) + ((((u:s1 . s1) (u:s2 . s2)) . body3) + (((u:s3 . s3) (u:s4 . s4)) . body4))) + (process-export-mac (prefix u: test-sig))) + +(test-syntax-error "process-export: rename clause id not in spec" + (process-export-mac (rename test-sig (z a)))) +(test-syntax-error "process-export-mac: rename, duplicate" + (process-export-mac (rename test-sig (a x) (b x)))) +(test stx-bound-id=? #'(((x . x) (a . y)) + ((((b . v1) (v2 . v2)) . body1) + (((v3 . v3) (v4 . v4)) . body2)) + ((((s1 . s1) (c . s2)) . body3) + (((s3 . s3) (s4 . s4)) . body4))) + (process-export-mac (rename test-sig (a y) (b v1) (c s2)))) + +;; + + +(define-syntax (extract-sig-runtime-macro stx) + (parameterize ((error-syntax stx)) + (syntax-case stx () + ((_ x) + #`#'#,(syntax-local-introduce (car (siginfo-rtime-ids (signature-siginfo (lookup-signature #'x))))))))) + +(test bound-identifier=? #'rt + (extract-sig-runtime-macro test-sig)) + +;; Complete-exports +(define s1 (make-siginfo '(a1 a2) '(c1 c2) ())) +(define s2 (make-siginfo '(b1 b2) '(c3 c2) ())) +(define s3 (make-siginfo '(b1 b2) '(c3 c2) ())) +(define s4 (make-siginfo '(c1 c2) '(c5 c4) ())) +(define s5 (make-siginfo '(d) '(c4) ())) +(define e1 (make-link-record #f #f #'a s1)) +(define e2 (make-link-record #f #f #'b s2)) +(define e3 (make-link-record 't #f #'b s3)) +(define e4 (make-link-record 't #f #'c s4)) +(define e5 (make-link-record 't #f #'d s5)) +(define unit-exports (list e1 e2 e3 e4)) + +(define (add-lnkid l lr) + (make-link-record (link-record-tag lr) l (link-record-sigid lr) (link-record-siginfo lr))) + +(define (lnk-comp lr1 lr2) + (andmap + (λ (lr1 lr2) + (and (eq? (link-record-tag lr1) (link-record-tag lr2)) + (bound-identifier=? (link-record-sigid lr1) (link-record-sigid lr2)) + (eq? (link-record-siginfo lr1) (link-record-siginfo lr2)) + (if (and (link-record-linkid lr1) (link-record-linkid lr2)) + (equal? (link-record-linkid lr1) (link-record-linkid lr2)) + #t))) + lr1 + lr2)) + +(test lnk-comp unit-exports + (complete-exports unit-exports '())) + +(test lnk-comp (map add-lnkid '(4 3 2 1) unit-exports) + (complete-exports unit-exports (map add-lnkid '(1 2 3 4) (reverse unit-exports)))) + +(let ([r (complete-exports unit-exports (list (add-lnkid 1 e2) (add-lnkid 2 e3)))]) + (test lnk-comp unit-exports r)) + +(let ([r (complete-exports unit-exports (list (add-lnkid 1 e5)))]) + (test lnk-comp unit-exports r)) + +(parameterize ([error-syntax #'complete-exports]) + + (test-runtime-error exn:fail:syntax? "complete-exports: duplicate bindings" + (complete-exports unit-exports (list (add-lnkid 1 e2) (add-lnkid 2 e3) (add-lnkid 3 e2)))) + + (test-runtime-error exn:fail:syntax? "complete-exports: duplicate bindings" + (complete-exports unit-exports (list (add-lnkid 1 e4) (add-lnkid 2 e5)))) + + (test-runtime-error exn:fail:syntax? "complete-exports: invalid link" + (complete-exports unit-exports (list (make-link-record #f 1 #'z (make-siginfo 'z '(c9) ()))))) + + (test-runtime-error exn:fail:syntax? "complete-exports: ambiguous links" + (complete-exports unit-exports (list (make-link-record #f 1 #'z (make-siginfo 'z '(c2) ())))))) + + +(define unit-imports (cons e5 unit-exports)) + +(define sig-table + (make-immutable-hash-table `((c1 . duplicate) + (c2 . 1) + (c3 . 2)))) + +(test lnk-comp `(,(add-lnkid 3 e4) ,(add-lnkid 4 e1) ,(add-lnkid 2 e2) ,(add-lnkid 2 e3)) + (complete-imports sig-table `(,(add-lnkid 3 e4) ,(add-lnkid 4 e1)) unit-imports #'stx)) + +(test lnk-comp `(,(add-lnkid 3 e4) ,(add-lnkid 4 e1) ,(add-lnkid 5 e2) ,(add-lnkid 2 e3)) + (complete-imports sig-table `(,(add-lnkid 3 e4) ,(add-lnkid 4 e1) ,(add-lnkid 5 e2)) unit-imports #'stx)) + +(test lnk-comp `(,(add-lnkid 3 e4) ,(add-lnkid 4 e1) ,(add-lnkid 5 e3) ,(add-lnkid 2 e2)) + (complete-imports sig-table `(,(add-lnkid 3 e4) ,(add-lnkid 4 e1) ,(add-lnkid 5 e3)) unit-imports #'stx)) + +(parameterize ([error-syntax #'complete-imports]) + + (test-runtime-error exn:fail:syntax? "complete-imports: ambiguous" + (complete-imports sig-table `(,(add-lnkid 3 e4)) unit-imports #'stx)) + + (test-runtime-error exn:fail:syntax? "complete-imports: missing" + (complete-imports sig-table `(,(add-lnkid 4 e1)) unit-imports #'stx)) + + (test-runtime-error exn:fail:syntax? "complete-imports: duplicate" + (complete-imports sig-table + `(,(add-lnkid 4 e1) ,(add-lnkid 5 e2)) + `(,(make-link-record #f #f #'e (make-siginfo '(a2) '(c2) ()))) + #'stx)) + ) diff --git a/collects/tests/units/test-unit-syntax.ss b/collects/tests/units/test-unit-syntax.ss new file mode 100644 index 0000000000..0eb475de22 --- /dev/null +++ b/collects/tests/units/test-unit-syntax.ss @@ -0,0 +1,292 @@ +(require "test-harness.ss" + ;unit-syntax + (lib "unit-syntax.ss" "mzlib" "private") + ) + + ;; check-id +(parameterize ([error-syntax #'check-id]) + (test-runtime-error exn:fail:syntax? "check-id: not id" + (check-id #'1)) + (test-runtime-error exn:fail:syntax? "check-id: not id" + (check-id #'(x y))) + (test bound-identifier=? #'x (check-id #'x))) + + ;; checked-syntax->list +(parameterize ([error-syntax #'checked-syntax->list]) + (test-runtime-error exn:fail:syntax? "checked-syntax->list: dot" + (checked-syntax->list #'(a b . c))) + (test-runtime-error exn:fail:syntax? "checked-syntax->list: not list" + (checked-syntax->list #'a)) + (test lst-bound-id=? (list #'a #'b #'c) + (checked-syntax->list #'(a b c))) + (test '() + (checked-syntax->list #'()))) + +;; checked-tag +(parameterize([error-syntax #'check-tagged]) + (test-runtime-error exn:fail:syntax? "check-tagged: missing all" + ((check-tagged (λ (x) x)) #'(tag))) + (test-runtime-error exn:fail:syntax? "check-tagged: missing syntax" + ((check-tagged (λ (x) x)) #'(tag a))) + (test-runtime-error exn:fail:syntax? "check-tagged: too much" + ((check-tagged (λ (x) x)) #'(tag a b c))) + (test-runtime-error exn:fail:syntax? "check-tagged: dot" + ((check-tagged (λ (x) x)) #'(tag a . c))) + (test-runtime-error exn:fail:syntax? "check-tagged: bad id" + ((check-tagged (λ (x) x)) #'(tag 1 c))) + (test stx-bound-identifier=? #'c + (cdr ((check-tagged (λ (x) x)) #'(tag b c)))) + (test 'b + (car ((check-tagged (λ (x) x)) #'(tag b c)))) + (test #f + (car ((check-tagged (λ (x) x)) #'1))) + (test 1 + (syntax-e (cdr ((check-tagged (λ (x) x)) #'1))))) + +;; check-:-clause-syntax +(parameterize ((error-syntax #'check-:-clause-syntax)) + (test-runtime-error exn:fail:syntax? "check-:-clause-syntax: malformed" + (check-:-clause-syntax #'x)) + (test-runtime-error exn:fail:syntax? "check-:-clause-syntax: malformed" + (check-:-clause-syntax #'(x y))) + (test-runtime-error exn:fail:syntax? "check-:-clause-syntax: malformed" + (check-:-clause-syntax #'(x y z))) + (test-runtime-error exn:fail:syntax? "check-:-clause-syntax: dot" + (check-:-clause-syntax #'(x : . z))) + (test-runtime-error exn:fail:syntax? "check-:-clause-syntax: malformed" + (check-:-clause-syntax #'(x : z a))) + + (test lst-bound-id=? (list #'a #'b) + (list (car (check-:-clause-syntax #'(a : b))) + (cdr (check-:-clause-syntax #'(a : b))))) + ) + +;; check-spec-syntax +(parameterize ((error-syntax #'check-spec-syntax)) + (define (css x) (check-spec-syntax x #t identifier?)) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: unknown keyword" + (css #'(x y))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: dot" + (css #'(x . y))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: not id" + (css #'1)) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: not id" + (css #'(only 1))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: not id" + (css #'(except 1))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: not id" + (css #'(rename 1))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: not id" + (css #'(prefix x 1))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: only, no args" + (css #'(only))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: only, arg not id" + (css #'(only test-sig 1))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: only, dot" + (css #'(only . test-sig))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: only, dot" + (css #'(only test-sig x . y))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: except, no args" + (css #'(except))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: except, arg not id" + (css #'(except test-sig 1))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: except, dot" + (css #'(except . test-sig))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: except, dot" + (css #'(except test-sig x . y))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: prefix, no args" + (css #'(prefix))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: prefix, one arg" + (css #'(prefix a))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: prefix, dot" + (css #'(prefix a . b))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: prefix, too many args" + (css #'(prefix a b c))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename, no args" + (css #'(rename))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename, dot" + (css #'(rename . test-sig))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename, dot" + (css #'(rename test-sig . (a x)))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename clause, length" + (css #'(rename test-sig (x)))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename clause, length" + (css #'(rename test-sig (a b x)))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename clause, dot" + (css #'(rename test-sig (a . x)))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename clause, dot" + (css #'(rename test-sig (a x) (a . x)))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename clause, id" + (css #'(rename test-sig (1 x)))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: rename clause, id" + (css #'(rename test-sig (a 1)))) + (test (void) + (css #'(prefix x (except (rename (only y)))))) + (test (void) + (css #'(only (except (rename (prefix x y) (a b) (c d)) e f g) h i j))) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: bad keyword" + (check-spec-syntax #'(only x) #f identifier?)) + (test-runtime-error exn:fail:syntax? "check-spec-syntax: bad keyword" + (check-spec-syntax #'(except x) #f identifier?)) + ) + +;; check-unit-syntax +(parameterize ((error-syntax #'check-unit-syntax)) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: no import or export" + (check-unit-syntax #'())) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: bad import" + (check-unit-syntax #'((export)))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: bad import" + (check-unit-syntax #'((impor) (export)))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: bad import" + (check-unit-syntax #'(import (export)))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: no export" + (check-unit-syntax #'((import)))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: bad export" + (check-unit-syntax #'((import) (expor)))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: bad export" + (check-unit-syntax #'((import) export))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: malformed body (dot)" + (check-unit-syntax #'((import) (export) 1 . 2))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: malformed import (dot)" + (check-unit-syntax #'((import . a) (export)))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: malformed export (dot)" + (check-unit-syntax #'((import) (export . a)))) + (test-runtime-error exn:fail:syntax? "check-unit-syntax: malformed init-depend (dot)" + (check-unit-syntax #'((import) (export) (init-depend . a)))) + (test stx-bound-id=? #'((import a b c) (export a b c) (init-depend) 1 2 3) + (check-unit-syntax #'((import a b c) (export a b c) 1 2 3))) + (test stx-bound-id=? #'((import a b c) (export a b c) (init-depend x y) 1 2 3) + (check-unit-syntax #'((import a b c) (export a b c) (init-depend x y) 1 2 3))) + (test bound-identifier=? #'init-depend + (car (syntax-e (caddr (syntax->list (check-unit-syntax #'((import) (export)))))))) + ) + +;; check-unit-body-syntax +(parameterize ((error-syntax #'check-unit-body-syntax)) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: no exp or import or export" + (check-unit-body-syntax #'())) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: no import or export" + (check-unit-body-syntax #'(1))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: bad import" + (check-unit-body-syntax #'(1 (export)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: bad import" + (check-unit-body-syntax #'(1 (impor) (export)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: bad import" + (check-unit-body-syntax #'(1 import (export)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: no export" + (check-unit-body-syntax #'(1 (import)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: bad export" + (check-unit-body-syntax #'(1 (import) (expor)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: bad export" + (check-unit-body-syntax #'(1 (import) export))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: malformed import (dot)" + (check-unit-body-syntax #'(1 (import . a) (export)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: malformed export (dot)" + (check-unit-body-syntax #'(1 (import) (export . a)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: malformed init-depend (dot)" + (check-unit-body-syntax #'(1 (import) (export) (init-depend . a)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: bad init-depend" + (check-unit-body-syntax #'(1 (import) (export) (init-depen)))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: too many" + (check-unit-body-syntax #'(1 (import) (export) (init-depend) x))) + (test-runtime-error exn:fail:syntax? "check-unit-body-syntax: bad dot" + (check-unit-body-syntax #'(1 (import) (export) . (init-depend)))) + (test stx-bound-id=? #'(1 (import a b c) (export a b c) (init-depend)) + (check-unit-body-syntax #'(1 (import a b c) (export a b c)))) + (test `(1 (import a b c) (export a b c) (init-depend x y)) + (syntax-object->datum (check-unit-body-syntax #'(1 (import a b c) (export a b c) (init-depend x y))))) + (test bound-identifier=? #'init-depend + (car (syntax-e (cadddr (syntax->list (check-unit-body-syntax #'(1 (import) (export)))))))) + ) + +;; check-link-line-syntax +(parameterize ((error-syntax #'check-link-line-syntax)) + (test-runtime-error exn:fail:syntax? "check-link-line-syntax: malformed" + (check-link-line-syntax #'1)) + (test-runtime-error exn:fail:syntax? "check-link-line-syntax: bad export list" + (check-link-line-syntax #'(a b))) + (test-runtime-error exn:fail:syntax? "check-link-line-syntax: missing unit expression" + (check-link-line-syntax #'(()))) + (test-runtime-error exn:fail:syntax? "check-link-line-syntax: dot" + (check-link-line-syntax #'((a . b) u))) + (test-runtime-error exn:fail:syntax? "check-link-line-syntax: dot" + (check-link-line-syntax #'((a b) u c . d))) + (test (void) + (check-link-line-syntax #'((a b c) u 1 2 3))) + ) + +;; check-compound-syntax +(parameterize ((error-syntax #'check-compound-syntax)) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: no import, export, or link" + (check-compound-syntax #'())) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: import malformed" + (check-compound-syntax #'(import (export) (link)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: import malformed" + (check-compound-syntax #'((impor) (export) (link)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: import dot" + (check-compound-syntax #'((import a b . 3) (export) (link)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: missing link and export clause" + (check-compound-syntax #'((import)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: bad export" + (check-compound-syntax #'((import) export (link)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: bad export" + (check-compound-syntax #'((import) (expor) (link)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: export dot" + (check-compound-syntax #'((import) (export a . b) (link)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: missing link clause" + (check-compound-syntax #'((import) (export)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: 2 link clauses" + (check-compound-syntax #'((import) (export) (link) (link)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: 2 export clauses" + (check-compound-syntax #'((import) (export) (link) (export)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: 2 import clauses" + (check-compound-syntax #'((import) (export) (link) (import)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: link dot" + (check-compound-syntax #'((import) (export) (link a b . 3)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: link clause malformed" + (check-compound-syntax #'((import) (export) (lnk)))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: link clause malformed" + (check-compound-syntax #'((import) (export) link))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: after link clause" + (check-compound-syntax #'((import) (export) (link) 3))) + (test-runtime-error exn:fail:syntax? "check-compound-syntax: dot" + (check-compound-syntax #'((import) (export) (link) . 3))) + + (test stx-bound-id=? #'((a b) + (c d) + (((e f) g h i) + (() x))) + (check-compound-syntax #'((link ((e f) g h i) + (() x)) + (export c d) + (import a b)))) + ) + +;; check-def-syntax +(parameterize ((error-syntax #'check-def-syntax)) + (test-runtime-error exn:fail:syntax? "define-values: missing ids and expr" + (check-def-syntax #'(define-values))) + (test-runtime-error exn:fail:syntax? "define-values: missing expr" + (check-def-syntax #'(define-values (a)))) + (test-runtime-error exn:fail:syntax? "define-values: 2 expr" + (check-def-syntax #'(define-values (a) 1 2))) + (test-runtime-error exn:fail:syntax? "define-values: dot" + (check-def-syntax #'(define-values (a) . 1))) + (test-runtime-error exn:fail:syntax? "define-values: bad ids" + (check-def-syntax #'(define-values x 1))) + (test-runtime-error exn:fail:syntax? "define-values: bad id" + (check-def-syntax #'(define-values (1) 1))) + (test-runtime-error exn:fail:syntax? "define-values: bad id (dot)" + (check-def-syntax #'(define-values (a . b) 1))) + (test-runtime-error exn:fail:syntax? "define-syntaxes: bad id (dot)" + (check-def-syntax #'(define-syntaxes (a . b) 1))) + + (test (void) + (check-def-syntax #'(define-values (a b c) 1))) + (test (void) + (check-def-syntax #'(define-values () 1))) + (test (void) + (check-def-syntax #'(define-syntaxes (a b c) 1))) + + ) diff --git a/collects/tests/units/test-unit.ss b/collects/tests/units/test-unit.ss new file mode 100644 index 0000000000..1e933d3a87 --- /dev/null +++ b/collects/tests/units/test-unit.ss @@ -0,0 +1,1643 @@ +(require-for-syntax (lib "unit-compiletime.ss" "mzlib" "private") + (lib "unit-syntax.ss" "mzlib" "private")) +(require "test-harness.ss" + ;unit + (lib "unit.ss")) + +(define-syntax (lookup-sig-mac stx) + (parameterize ((error-syntax stx)) + (syntax-case stx () + ((_ id) + #`#'#,(let ((s (lookup-signature #'id))) + (list (map syntax-local-introduce (signature-vars s)) + (map (lambda (def) + (cons (map syntax-local-introduce (car def)) + (syntax-local-introduce (cdr def)))) + (signature-val-defs s)) + (map (lambda (def) + (cons (map syntax-local-introduce (car def)) + (syntax-local-introduce (cdr def)))) + (signature-stx-defs s)))))))) + +(define-signature x-sig (x)) +(define-signature x-sig2 (x)) +(define-signature y-sig (y)) +(define-signature z-sig (z)) + +(define-signature yz-sig (y z)) +(define-signature xy-sig (x y)) +(define-signature empty-sig ()) +(define-signature b-sig (b)) + +(define-signature empty-sub extends empty-sig ()) + +(define-signature x-sub extends x-sig (xx)) +(define-signature y-sub extends y-sig (yy)) +(define-signature x-sub2 extends x-sig (x2)) + + + +;; Keyword errors +(test-syntax-error "misuse of import" + import) +(test-syntax-error "misuse of export" + export) +(test-syntax-error "misuse of init-depend" + init-depend) +(test-syntax-error "misuse of link" + link) +(test-syntax-error "misuse of only" + only) +(test-syntax-error "misuse of except" + except) +(test-syntax-error "misuse of prefix" + prefix) +(test-syntax-error "misuse of rename" + rename) +(test-syntax-error "misuse of tag" + tag) + +;; define-signature-forms syntax errors +(test-syntax-error "define-signature-form: missing arguments" + (define-signature-form)) +(test-syntax-error "define-signature-form: missing arguments" + (define-signature-form (a b))) +(test-syntax-error "define-signature-form: too many arguments" + (define-signature-form (a b c) 1 2)) +(test-syntax-error "define-signature-form: dot" + (define-signature-form (a b) . c)) +(test-syntax-error "define-signature-form: set!" + (let () + (define-signature-form (a b) b) + (set! a 1))) + +(test-syntax-error "define-signature-form: bad params" + (define-signature-form 1 2)) +(test-syntax-error "define-signature-form: bad params" + (define-signature-form a 2)) +(test-syntax-error "define-signature-form: name not id" + (define-signature-form (1 a) 1)) +(test-syntax-error "define-signature-form: param not id" + (define-signature-form (a 1) 1)) +(test-syntax-error "define-signature-form: param dot" + (define-signature-form (a . b) 1)) + + +;; define-signature syntax-errors +(test-syntax-error "define-signature: missing name" + (define-signature)) +(test-syntax-error "define-signature: missing sig" + (define-signature x)) +(test-syntax-error "define-signature: too many args" + (define-signature x (a b) 1)) +(test-syntax-error "define-signature: bad name" + (define-signature 1 (a b))) +(test-syntax-error "define-signature: bad name" + (define-signature x extends 1 (a b))) +(test-syntax-error "define-signature: not a signature" + (define-signature x extends y12 (a b))) +(test-syntax-error "define-signature: not a signature" + (let () (define-signature x extends x (a b)))) +(test-syntax-error "define-signature: bad name" + (define-signature (a . b) (a b))) +(test-syntax-error "define-signature: dot" + (define-signature b . (a b))) +(test-syntax-error "define-signature: dot" + (define-signature b (a b) . 2)) +(test-syntax-error "define-signature: set!" + (let () + (define-signature a (a)) + (set! a 1))) +(test-syntax-error "define-signature: bad sig" + (define-signature x y)) +(test-syntax-error "define-signature: bad sig" + (define-signature x (1))) +(test-syntax-error "define-signature: bad sig" + (define-signature x (a . b))) +(test-syntax-error "define-signature: bad signature form" + (define-signature x ((a)))) +(test-syntax-error "define-signature: bad signature form" + (define-signature x ((define-signature)))) +(test-syntax-error "define-values: malformed (in define-signature)" + (define-signature x ((define-values 1 2)))) +(test-syntax-error "define-signature: bad form (does not return list)" + (let () + (define-signature-form (a b) 1) + (define-signature x ((a 1))))) +(test-syntax-error "define-signature: unknown form" + (let () + (define-signature-form (a b) (list #'(c d))) + (define-signature x ((a 1))) + 1)) +(test-syntax-error "define-signature: duplicate name" + (define-signature x (a a))) +(test-syntax-error "define-signature: duplicate values" + (define-signature x (a (define-values (a) 1)))) +(test-syntax-error "define-signature: duplicate values" + (define-signature x (a (define-values (b b) 1)))) +(test-syntax-error "define-signature: duplicate values" + (define-signature x (a (define-values (b) 1) (define-syntaxes (b) 1)))) +(test-syntax-error "define-signature: duplicate values" + (let () + (define-signature test (y)) + (define-signature x extends test ((define-values (y) 1))))) + +;; define-signature +(test stx-bound-id=? #'((a b) () ()) + (let () + (define-signature x (a b)) + (lookup-sig-mac x))) +(let () + (define-signature super (s1 (define-values (s2 s3) s4) (define-syntaxes (s5 s6) s7))) + (test stx-bound-id=? #'((s1 a b f) (((s2 s3) . s4) ((c d) . e) ((i) . j)) (((s5 s6) . s7) ((g) . h))) + (let () + (define-signature x extends super (a b (define-values (c d) e) f + (define-syntaxes (g) h) + (define-values (i) j))) + (lookup-sig-mac x)))) +(let () + (define-signature super (s1 (define-values (s2 s3) s4) (define-syntaxes (s5 s6) s7))) + (let ((a 1) (g 2) (j 3) (s1 4) (s2 5) (s7 6)) + (test stx-bound-id=? #'(((#f . s1) a b f) ((((#f . s2) s3) . s4) ((c d) . e) ((i) . j)) (((s5 s6) . (#f . s7)) ((g) . h))) + (let () + (define-signature x extends super (a b (define-values (c d) e) f + (define-syntaxes (g) h) + (define-values (i) j))) + (lookup-sig-mac x))))) +(let () + (define-signature super (s1 (define-values (s2 s3) s4) (define-syntaxes (s5 s6) s7))) + (test stx-bound-id=? #'((s1 a b f) (((s2 s3) . s4) ((c d) . e) ((i) . j)) (((s5 s6) . s7) ((g) . h))) + (let () + (define-signature x extends super (a b (define-values (c d) e) f + (define-syntaxes (g) h) + (define-values (i) j))) + (let ((a 1) (g 2) (j 3)) + (lookup-sig-mac x))))) +(test stx-bound-id=? #'(((#f . a) b f) (((c d) . e) ((i) . (#f . j))) ((((#f . g)) . h))) + (let ((a 1) (g 2) (j 3)) + (define-signature x (a b (define-values (c d) e) f + (define-syntaxes (g) h) + (define-values (i) j))) + (lookup-sig-mac x))) +(let () + (define-signature-form (x y) + (list (cdr (syntax-e y)))) + (test stx-bound-id=? #'((a) + () + ()) + (let () + (define-signature z ((x . a))) + (lookup-sig-mac z)))) + + +;; unit syntax errors (without sub-signatures) +(test-syntax-error "unit: bad sig import" + (unit (import 1) (export))) +(test-syntax-error "unit: bad sig export" + (unit (import) (export 1))) +(test-syntax-error "unit: unknown sig import" + (unit (import a) (export))) +(test-syntax-error "unit: unknown sig export" + (unit (import) (export a))) +(test-syntax-error "unit: bad tag (not identifier)" + (unit (import (tag 1 empty-sig)) (export))) +(test-syntax-error "unit: bad tag (not identifier)" + (unit (import) (export (tag 'a empty-sig)))) +(test-syntax-error "define-values: bad syntax (in unit)" + (unit (import) (export) (define-values))) +(test-syntax-error "unit: multiple definition" + (unit (import) (export) (define-values (x x) (values 1 2)))) +(test-syntax-error "unit: multiple definition" + (unit (import) (export) (define-syntaxes (x x) (values 1 2)))) +(test-syntax-error "unit: multiple definition" + (unit (import) (export) (define x 1) (define x 2))) +(test-syntax-error "unit: multiple definition" + (unit (import) (export) (define-syntax x 1) (define-syntax x 2))) +(test-syntax-error "unit: multiple definition" + (unit (import) (export) (define x 1) (define-syntax x 2))) +(test-syntax-error "unit: re-export" + (unit (import x-sig) (export x-sig) (define x 1))) +(test-syntax-error "unit: redefine import" + (unit (import x-sig) (export) (define x 1))) +(test-syntax-error "unit: set! import" + (unit (import x-sig) (export) (set! x 1))) +(test-syntax-error "unit: set! export" + (unit (import) (export x-sig) (define x 1) (set! x 1))) +(test-syntax-error "unit: undefined export" + (unit (import) (export x-sig))) +(test-syntax-error "unit: undefined export" + (unit (import) (export (prefix x: x-sig)) (define x 1))) +(test-syntax-error "unit: syntax export" + (unit (import) (export x-sig) (define-syntax x 1))) +(test-syntax-error "unit: duplicate import" + (unit (import x-sig x-sig2) (export))) +(test-syntax-error "unit: duplicate export" + (unit (import) (export x-sig x-sig2) (define x 12))) +(test-syntax-error "unit: duplicate import signature" + (unit (import x-sig (prefix a x-sig)) (export))) +(test-syntax-error "unit: duplicate export signature" + (unit (import) (export x-sig (prefix a x-sig)) + (define x 1) (define ax 2))) +(test-syntax-error "unit: duplicate import signature" + (unit (import (tag t x-sig) (tag t (prefix a x-sig))) (export))) +(test-syntax-error "unit: duplicate export signature" + (unit (import) (export (tag t x-sig) (tag t (prefix a x-sig))) + (define x 1) (define ax 2))) +(test-syntax-error "unit: duplicate export signature" + (unit (import) (export x-sig x-sig) + (define x 1))) + + +;; compound-unit syntax errors (without sub-signatures) +(test-syntax-error "compound-unit: bad import clause" + (compound-unit (import (a empty-sig)) (export) (link))) +(test-syntax-error "compound-unit: import clause bad link id" + (compound-unit (import (1 : empty-sig)) (export) (link))) +(test-syntax-error "compound-unit: import clause unknown sig" + (compound-unit (import (a : empty-si)) (export) (link))) +(test-syntax-error "compound-unit: export bad link id" + (compound-unit (import) (export a 1 b) (link))) +(test-syntax-error "compound-unit: link line bad link id" + (compound-unit (import) (export) (link (((a : empty-sig)) b 1)))) +(test-syntax-error "compound-unit: import clause bad sig id" + (compound-unit (import (a : ())) (export) (link))) +(test-syntax-error "compound-unit: link line clause bad sig id" + (compound-unit (import) (export) (link (((a : "")) b)))) +(test-syntax-error "compound-unit: link line clause bad" + (compound-unit (import) (export) (link (((a empty-sig)) b)))) +(test-syntax-error "compound-unit: link line clause unknown" + (compound-unit (import) (export) (link (((a : b)) b)))) +(test-syntax-error "compound-unit: duplicate link ids" + (compound-unit (import (x : x-sig) (x : y-sig)) (export) (link))) +(test-syntax-error "compound-unit: duplicate link ids" + (compound-unit (import) (export) (link (((x : x-sig) (x : y-sig)) u)))) +(test-syntax-error "compound-unit: duplicate link ids" + (compound-unit (import (x : x-sig)) (export) (link (((x : x-sig)) u)))) +(test-syntax-error "export: unbound link id" + (compound-unit (import) (export a) (link))) +(test-syntax-error "link link: unbound link id" + (compound-unit (import) (export) (link (() u a)))) +(test-syntax-error "compound-unit: re-export" + (compound-unit (import (S : x-sig)) (export S) (link))) +(test-syntax-error "compound-unit: re-export" + (compound-unit (import (tag s (S : x-sig))) (export (tag t S)) (link))) +(test-syntax-error "compound-unit: duplicate export signature" + (compound-unit (import) (export X1 X2) + (link (((X1 : x-sig)) (unit (import) (export x-sig) (define x 1))) + (((X2 : x-sig)) (unit (import) (export x-sig) (define x 1)))))) +(test-syntax-error "compound-unit: duplicate export signature" + (compound-unit (import) (export (tag t X1) (tag t X2)) + (link (((X1 : x-sig)) (unit (import) (export x-sig) (define x 1))) + (((X2 : x-sig)) (unit (import) (export x-sig) (define x 1)))))) + +;; define-values/invoke-unit syntax errors +(test-syntax-error "define-values/invoke-unit: no unit" + (define-values/invoke-unit)) +(test-syntax-error "define-values/invoke-unit: dot" + (define-values/invoke-unit x y . x)) +(test-syntax-error "define-values/invoke-unit: bad sig" + (define-values/invoke-unit 1 1)) +(test-syntax-error "define-values/invoke-unit: duplicate exports" + (define-values/invoke-unit (unit (import) (export (prefix x: x-sig) x-sig2) + (define x 1) + (define x:x 2)) + x-sig x-sig2)) + + +;; simple units, compound-units, and invoke-units (no subtypes, no tags, no prefix/rename/etc, no fancy signatures) +(test 12 + (invoke-unit (unit (import) (export) 12))) + +(test 3 + (invoke-unit + (compound-unit (import) (export) + (link (((X : x-sig) (Y : y-sig)) (unit (import empty-sig z-sig) + (export y-sig x-sig) + (define x 1) + (define y 2)) + Z E) + (((Z : z-sig) (E : empty-sig)) (unit (import x-sig y-sig) + (export empty-sig z-sig) + (define z 3) + 3) X Y))))) + + +;; Test compound export with signatures containing overlapping names +(test (list 10 11 12) + (let ((un (compound-unit (import) (export S U) + (link (((S : x-sig)) (unit (import) (export x-sig) (define x 10))) + (((U : xy-sig)) (unit (import) (export xy-sig) (define x 11) (define y 12))))))) + (invoke-unit + (compound-unit (import) (export) + (link (((S : x-sig) (U : xy-sig)) un) + (((B : b-sig)) (unit (import x-sig) (export b-sig) (define b x)) S) + (() (unit (import b-sig xy-sig) (export) (list b x y)) B U)))))) + +(define-signature even-sig (even)) +(define-signature odd-sig (odd)) + +(define even-unit + (unit (import odd-sig) + (export even-sig) + (define (even x) + (or (= 0 x) (odd (sub1 x)))))) + +(define odd-unit + (unit (import even-sig) + (export odd-sig) + (define (odd x) + (and (> x 0) (even (sub1 x)))) + (define x (odd 11)) + x)) + +(define run-unit + (compound-unit (import) + (export) + (link (((EVEN : even-sig)) even-unit ODD) + (((ODD : odd-sig)) odd-unit EVEN)))) + +(test #t (invoke-unit run-unit)) + +(define-signature is-3x-sig (is-3x)) +(define-signature is-3x+1-sig (is-3x+1)) +(define-signature is-3x+2-sig (is-3x+2)) + +(define is-3x-unit + (unit (import is-3x+2-sig) + (export is-3x-sig) + (define (is-3x x) + (or (= 0 x) (is-3x+2 (sub1 x)))))) + +(define is-3x+2-unit + (unit (import is-3x+1-sig) + (export is-3x+2-sig) + (define (is-3x+2 x) + (and (> x 0) (is-3x+1 (sub1 x)))))) + +(define is-3x+1-unit + (unit (import is-3x-sig) + (export is-3x+1-sig) + (define (is-3x+1 x) + (and (> x 0) (is-3x (sub1 x)))))) + +(define 3x-compound1 + (compound-unit (import (IS-3X : is-3x-sig)) + (export IS-3X+1 IS-3X+2) + (link (((IS-3X+1 : is-3x+1-sig)) is-3x+1-unit IS-3X) + (((IS-3X+2 : is-3x+2-sig)) is-3x+2-unit IS-3X+1)))) + +(define 3x-compound2 + (compound-unit (import) + (export IS-3X) + (link (((IS-3X : is-3x-sig)) is-3x-unit IS-3X+2) + (((IS-3X+1 : is-3x+1-sig) + (IS-3X+2 : is-3x+2-sig)) 3x-compound1 IS-3X)))) + +(define 3x-run-unit + (unit (import is-3x-sig is-3x+1-sig is-3x+2-sig) + (export) + (list (is-3x 1) + (is-3x 3) + (is-3x+1 5) + (is-3x+1 7) + (is-3x+2 4) + (is-3x+2 8)))) + +(define 3x-compound3 + (compound-unit (import) + (export IS-3X IS-3X+1 IS-3X+2) + (link (((IS-3X : is-3x-sig)) 3x-compound2) + (((IS-3X+1 : is-3x+1-sig) + (IS-3X+2 : is-3x+2-sig)) 3x-compound1 IS-3X) + (() 3x-run-unit IS-3X IS-3X+1 IS-3X+2)))) + +(test (list #f #t #f #t #f #t) + (invoke-unit 3x-compound3)) + +(test (list #t #t #t) + (let () + (define-values/invoke-unit 3x-compound3 (import) (export is-3x-sig is-3x+1-sig is-3x+2-sig)) + (list (is-3x+2 8) + (is-3x+1 7) + (is-3x 6)))) +(test (list #t #t #t) + (let () + (define-values/invoke-unit 3x-compound3 (import) (export (only is-3x-sig is-3x) (except is-3x+1-sig) (prefix x: is-3x+2-sig))) + (list (x:is-3x+2 8) + (is-3x+1 7) + (is-3x 6)))) +(test (list #t #t #t) + (let () + (define-values/invoke-unit 3x-compound3 (import) (export is-3x-sig is-3x+1-sig (rename is-3x+2-sig (y is-3x+2)))) + (list (y 8) + (is-3x+1 7) + (is-3x 6)))) + +;; Tags +(let () + (define u + (unit (import x-sig (tag t (prefix t: x-sig)) (tag u (prefix u: x-sig))) + (export) + (list x t:x u:x))) + (define v + (unit (import) + (export x-sig (tag t (prefix t: x-sig)) (tag u (prefix u: x-sig))) + (define x 1) + (define t:x 2) + (define u:x 3))) + (test '(3 1 2) + (invoke-unit + (compound-unit (import) (export) + (link (((X1 : x-sig) (X2 : (tag u x-sig)) (X3 : (tag t x-sig))) v) + (() u (tag t X1) X2 (tag u X3)))))) + (test '(3 1 2) + (invoke-unit + (compound-unit (import) (export) + (link (((L1 : (tag a x-sig)) (L2 : (tag b x-sig)) (L3 : (tag c x-sig))) + (compound-unit (import) (export (tag a X1) (tag b X2) (tag c X3)) + (link (((X1 : x-sig) (X2 : (tag u x-sig)) (X3 : (tag t x-sig))) v)))) + (() + (compound-unit (import (X1 : x-sig) (X2 : (tag u x-sig)) (X3 : (tag t x-sig))) (export) + (link (() u (tag t X1) X2 (tag u X3)))) + L1 (tag u L2) (tag t L3))))))) + +(let () + (define-values/invoke-unit (unit (import) (export (tag t x-sig)) (define x 1)) (import) (export (tag t x-sig))) + (test 1 x)) + +;; simple runtime errors (no subtyping, no deps) +(test-runtime-error exn:fail:contract? "compound-unit: not a unit" + (compound-unit (import) (export) (link (() 1)))) +(test-runtime-error exn:fail:contract? "compound-unit: missing import" + (compound-unit (import) (export) + (link (() (unit (import x-sig) (export)))))) +(test-runtime-error exn:fail:contract? "compound-unit: missing import" + (compound-unit (import (X : x-sig)) (export) + (link (() (unit (import x-sig) (export)) + (tag u X))))) +(test-runtime-error exn:fail:contract? "compound-unit: missing import" + (compound-unit (import (X : x-sig)) (export) + (link (() (unit (import (tag u x-sig)) (export)) + X)))) +(test-runtime-error exn:fail:contract? "compound-unit: missing export" + (compound-unit (import) (export) + (link (((X : x-sig)) (unit (import) (export)))))) +(test-runtime-error exn:fail:contract? "compound-unit: missing export" + (compound-unit (import) (export) + (link (((X : (tag u x-sig))) (unit (import) (export x-sig) (define x 1)))))) +(test-runtime-error exn:fail:contract? "compound-unit: missing export" + (compound-unit (import) (export) + (link (((X : x-sig)) (unit (import (tag u x-sig)) (export)))))) + +(test-runtime-error exn:fail:contract? "invoke-unit: not a unit" + (invoke-unit 1)) +(test-runtime-error exn:fail:contract? "invoke-unit: unit has imports" + (invoke-unit (unit (import x-sig) (export) x))) + +(test-runtime-error exn:fail:contract? "define-values/invoke-unit: not a unit" + (define-values/invoke-unit 1 (import) (export))) +(test-runtime-error exn:fail:contract? "define-values/invoke-unit: has imports" + (define-values/invoke-unit (unit (import x-sig) (export) x) (import) (export))) +(test-runtime-error exn:fail:contract? "define-values/invoke-unit: signature mismatch" + (define-values/invoke-unit (unit (import) (export)) (import) (export x-sig))) + +;; unit creation w/o signatures (including macros and prefixes/renames). + +;; free vars +(let ((y 1) + (z 10)) + (define u (unit (import) (export yz-sig) + (define y 2) + (define z 3))) + (define u1 (unit (import) (export) + y)) + (define u2 (unit (import (only yz-sig z)) (export) + y)) + (define u3 (unit (import (except yz-sig y)) (export) + y)) + (define u4 (unit (import (prefix s: yz-sig)) (export) + y)) + (define u5 (unit (import (rename yz-sig (r y))) (export) + y)) + (define u6 (unit (import yz-sig) (export) + y)) + (define (l x) + (invoke-unit + (compound-unit (import) (export) + (link (((YZ : yz-sig)) u) + (() x YZ))))) + (test 1 (invoke-unit u1)) + (test 1 (l u2)) + (test 1 (l u3)) + (test 1 (l u4)) + (test 1 (l u5)) + (test 2 (l u6)) + (test (letrec ((x x)) x) + (let () + (define-values/invoke-unit (unit-from-context yz-sig) (import) (export yz-sig)) + y)) + (test 1 + (let () + (let ((u (unit-from-context yz-sig))) + (define-values/invoke-unit u (import) (export (prefix x: yz-sig))) + x:y))) + ;; Exporting and prefix don't work right because the shadower doesn't see the shadowed + ;; bindings, I think. + #;(test 1 + (let ((x:y 12) + (x:z 10)) + (let ((u (unit-from-context (prefix x: yz-sig)))) + (define-values/invoke-unit u yz-sig) + y))) + #;(test 1 + (let ((x:y 12) + (x:z 10)) + (define-signature t (y z)) + (let ((u (unit-from-context (prefix x: t)))) + (define-values/invoke-unit u t) + y))) + (test 12 + (let ((x:y 12) + (x:z 10)) + (define-values/invoke-unit (unit-from-context (rename yz-sig (x:y y) (x:z z))) + (import) (export yz-sig)) + y)) + (test 12 + (let ((x:y 12) + (x:z 10)) + (define-signature t (y z)) + (let () + (define-values/invoke-unit (unit-from-context (rename t (x:y y) (x:z z))) (import) (export t)) + y)))) + +;; Test that a define-values can define both internal and exported vars +(test '(1 2) + (invoke-unit + (compound-unit (import) (export) + (link (((T : yz-sig)) (unit (import x-sig) (export yz-sig) + (define-values (y a) (values 1 2)) + (define-values (b z) (values y a))) + S) + (((S : x-sig)) (unit (import yz-sig) (export x-sig) (define x 3) (list y z)) T))))) + + +;; Test that internal macros can define exports +(test 1 + (invoke-unit + (unit (import) (export x-sig) + (define-syntax (y stx) + (syntax-case stx () + ((_ x) #'(define x 1)))) + (y x) + x))) + +(define-signature fact-sig (fact n)) + +;; Test renaming, self-recursion, only, and except +(test 24 + (invoke-unit + (compound-unit (import) (export) + (link (((F : fact-sig)) (unit (import (except (rename fact-sig (f-in fact)) n)) + (export (rename fact-sig (f-out fact))) + (define n 1) + (define (f-out x) (if (= 0 x) + 1 + (* x (f-in (sub1 x)))))) + F) + (() (unit (import (only fact-sig fact)) (export) + (define n 2) + (fact 4)) + F))))) + + +;; Test import prefix +(test 1 + (invoke-unit + (compound-unit (import) (export) + (link (((S : x-sig)) (unit (import) (export x-sig) (define x 1))) + (() (unit (import (prefix s: x-sig)) (export) s:x) S))))) + +(define-signature sx (x)) +(define-signature sy (y)) +(define-signature sz (z)) + +;; Test separate signatures with overlapping bindings, and export renaming and prefix +(test '(1 2 3) + (invoke-unit + (compound-unit (import) (export) + (link (((S : x-sig) (T : yz-sig) (U : xy-sig)) (unit (import) (export (rename x-sig (s:x x)) + (rename yz-sig (t:y y) (t:z z)) + (prefix u: xy-sig)) + (define x 1) (define y 2) (define z 3) + (define s:x x) (define t:y y) (define t:z z) (define u:x x) (define u:y y))) + (((SX : sx)) (unit (import (prefix s: x-sig)) (export sx) (define x s:x)) S) + (((SY : sy)) (unit (import (prefix u: xy-sig)) (export sy) (define y u:y)) U) + (((SZ : sz)) (unit (import (prefix t: yz-sig)) (export sz) (define z t:z)) T) + (() (unit (import sx sy sz) (export) (list x y z)) SX SY SZ))))) + + +;; Test units importing and exporting b, where lexical definition of b shadows +;; the b identifier in the signature +(test 2 + (let ((b 1)) + (define u1 (unit (import) (export b-sig) (define b 2))) + (define u2 (unit (import b-sig) (export) b)) + (invoke-unit (compound-unit (import) (export) + (link (((B : b-sig)) u1) + (() u2 B)))))) +(test 1 + (let ((b 1)) + (define u1 (unit-from-context b-sig)) + (let ((b 2)) + (define-values/invoke-unit u1 (import) (export b-sig)) + b))) + + + +(let ((x 1) + (v 2)) + (let-syntax ((s (syntax-rules () ((_) (list x v))))) + (define-signature t (x (define-syntaxes (s) + (syntax-rules () + ((_) (list x v)))) + (define-values (v) (add1 x)))) + (define-signature t2 (x (define-syntaxes (s) + (syntax-rules () + ((_) (list x v)))) + (define-values (v) (add1 x)))) + (define u3 (unit (import) (export t) + (define x 3))) + (define u4 (unit (import) (export t2) + (define x 4))) + (define (i u) + (invoke-unit + (compound-unit (import) (export) + (link (((T3 : t)) u3) + (((T4 : t2)) u4) + (() u T3 T4))))) + ;; prefix + (let ((x 5) + (v 6)) + (let-syntax ((s (syntax-rules () ((_) (list x v))))) + (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (prefix p: t) (prefix q: t2)) (export) + (define x 7) + (define v 8) + (define-syntax s (syntax-rules () ((_) (list x v)))) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))) + (test '(5 6 (5 6) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (prefix p: t) (prefix q: t2)) (export) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))))) + (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (prefix p: t) (prefix q: t2)) (export) + (define x 7) + (define v 8) + (define-syntax s (syntax-rules () ((_) (list x v)))) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))) + (test '(1 2 (1 2) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (prefix p: t) (prefix q: t2)) (export) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))) + ;; only + (let ((x 5) + (v 6)) + (let-syntax ((s (syntax-rules () ((_) (list x v))))) + (test '(7 8 (7 8) (3 4) (4 5)) + (i (unit (import (prefix p: (only t s)) (only (prefix q: t2) q:s)) (export) + (define x 7) + (define v 8) + (define-syntax s (syntax-rules () ((_) (list x v)))) + (list x v (s) (p:s) (q:s))))) + (test '(5 6 (5 6) (3 4) (4 5)) + (i (unit (import (prefix p: (only t s)) (prefix q: (only t2 s))) (export) + (list x v (s) (p:s) (q:s))))))) + (test '(7 8 (7 8) (3 4) (4 5)) + (i (unit (import (only (prefix p: t) p:s) (only (prefix q: t2) q:s)) (export) + (define x 7) + (define v 8) + (define-syntax s (syntax-rules () ((_) (list x v)))) + (list x v (s) (p:s) (q:s))))) + (test '(1 2 (1 2) (3 4) (4 5)) + (i (unit (import (prefix p: (only t s)) (prefix q: (only t2 s))) (export) + (list x v (s) (p:s) (q:s))))) + ;;rename + (let ((x 5) + (v 6)) + (let-syntax ((s (syntax-rules () ((_) (list x v))))) + (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (rename t (p:x x) (p:v v) (p:s s)) + (rename t2 (q:x x) (q:v v) (q:s s))) + (export) + (define x 7) + (define v 8) + (define-syntax s (syntax-rules () ((_) (list x v)))) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))) + (test '(5 6 (5 6) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (rename t (p:x x) (p:v v) (p:s s)) + (rename t2 (q:x x) (q:v v) (q:s s))) + (export) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))))) + (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (rename t (p:x x) (p:v v) (p:s s)) + (rename t2 (q:x x) (q:v v) (q:s s))) + (export) + (define x 7) + (define v 8) + (define-syntax s (syntax-rules () ((_) (list x v)))) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))) + (test '(1 2 (1 2) 3 4 (3 4) 4 5 (4 5)) + (i (unit (import (rename t (p:x x) (p:v v) (p:s s)) + (rename t2 (q:x x) (q:v v) (q:s s))) + (export) + (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))) + ) + +(let () + (define-signature x ((define-syntaxes (m) + (syntax-rules () + ((_ x) (define-syntax x + (syntax-rules () + ((_ y) y)))))) + (define-values (v) + (let () + (m a) + (a 1))))) + (test 1 + (invoke-unit + (compound-unit (import) (export) + (link (((X : x)) (unit (import) (export x))) + (() (unit (import x) (export) v) X)))))) +(let () + (define-signature x ((define-syntaxes (m) + (syntax-rules () + ((_ x) (define-syntax x #'1)))) + (define-syntaxes (m2) + (lambda (stx) + (syntax-case stx () + ((_ x) (syntax-local-value #'x))))) + (define-values (v) + (let () + (m a) + (m2 a))))) + (test 1 + (invoke-unit + (compound-unit (import) (export) + (link (((X : x)) (unit (import) (export x))) + (() (unit (import x) (export) v) X)))))) + +(let () + (define-signature x ((define-syntaxes (m) #'1) + (define-syntaxes (m2) + (lambda (stx) + (syntax-case stx () + ((_ x) (syntax-local-value #'x))))) + (define-values (v) + (let () + (m2 m))))) + (test 1 + (invoke-unit + (compound-unit (import) (export) + (link (((X : x)) (unit (import) (export x))) + (() (unit (import x) (export) v) X)))))) + + +(let () + (define-signature s1 (a (define-values (x y) (values 1 2)))) + (define-signature s2 extends s1 ((define-values (z) (list a x)))) + (define u1 (unit (import s2) (export) (cons y z))) + (define u2 (unit (import) (export s2) (define a 123))) + (test (list 2 123 1) (invoke-unit (compound-unit (import) (export) + (link (((a : s2)) u2) + (() u1 a)))))) +(let () + (define-signature s1 (a (define-values (x y) (values 1 2)))) + (let ((x 12)) + (define-signature s2 extends s1 ((define-values (z) (list a x)))) + (define u1 (unit (import s2) (export) (cons y z))) + (define u2 (unit (import) (export s2) (define a 123))) + (test (list 2 123 12) (invoke-unit (compound-unit (import) (export) + (link (((a : s2)) u2) + (() u1 a))))))) + +(let () + (define-signature s1 (a (define-values (x y) (values c 2)))) + (define-signature s2 extends s1 (c (define-values (z) (list a x)))) + (define u1 (unit (import s2) (export) (cons y z))) + (define u2 (unit (import) (export s2) (define a 123) (define c 43))) + (test (list 2 123 43) (invoke-unit (compound-unit (import) (export) + (link (((a : s2)) u2) + (() u1 a)))))) + +;; Test define-syntaxes and define-values, without except, only, prefix and rename +;; Check the scoping +(let ((a 'abad) + (b 'bbad) + (c 'cbad) + (v1 'v1bad) + (v2 'v2bad) + (s1 's1bad) + (s2 's2bad) + (strange-fact 'sfbad) + (z 'zbad)) + (define z 1) + (define a 'abad2) + (define c 'cbad2) + (define strange-fact 'sfbad4) + (define-signature macro (a b c + (define-values (v1) (list a b c z 2)) + (define-values (v2) (s2 a b c)) + (define-values (strange-fact) + (lambda (x) + (if (= x 0) (list z a b c) (cons x (strange-fact (sub1 x)))))) + (define-syntaxes (s1 s2) + (values + (syntax-rules () + ((_ a1 b1 c1) (list a b c v1 a1 b1 c1 z))) + (syntax-rules () + ((_ a1 b1 c1) (s1 a1 b1 c1))))))) + (let ((b 'bbad2) + (c 'cbad3)) + (define z 3) + (define u1 + (unit (import macro) (export) + (define z 4) + (list a b c v1 v2 (strange-fact 5) (s1 6 7 8) (s2 9 10 11)))) + (define u2 + (unit (import) (export macro) + (define a 12) + (define b 13) + (define c 14))) + (test '(12 13 14 + (12 13 14 1 2) + (12 13 14 (12 13 14 1 2) 12 13 14 1) + (5 4 3 2 1 1 12 13 14) + (12 13 14 (12 13 14 1 2) 6 7 8 1) + (12 13 14 (12 13 14 1 2) 9 10 11 1)) + (invoke-unit + (compound-unit (import) (export) + (link (((U2 : macro)) u2) + (() u1 U2))))))) + + +;; We can re-define imported values +(let () + (define-signature s ((define-values (y) 1))) + (define-signature t (z)) + (test 3 + (invoke-unit + (compound-unit (import) (export) + (link (((T : t)) (unit (import s) (export t) (define y 3) (define z y)) S) + (((S : s)) (unit (import) (export s) (define y 1))) + (() (unit (import t) (export) z) T)))))) + +;; Can't use imports as pattern variables +#;(let () + (define-signature s (y (define-syntaxes (m) (syntax-rules (y) ((_ y) 1))))) + (unit (import s) (export) + (m y))) + + +(test '(2 3) + (let () + (define-signature sig (y (define-values (v) (add1 y)))) + (let () + (define-values/invoke-unit + (unit (import) (export sig) (define y 2)) + (import) + (export sig)) + (list y v)))) + + +;; I'm not sure that this should work. +#;(test '(2 3) + (let () + (define-signature sig (y (define-values (v) (add1 y)))) + (define-values/invoke-unit + (unit (import) (export sig) (define y 2)) + sig) + (list y v))) + + + +;; subtyping + +(let () + (define u1 (unit (import x-sig) (export y-sub) (define y (add1 x)) (define yy 2) (list x y yy))) + (define u2 (unit (import y-sig) (export x-sub) (define x 3) (define xx 44))) + (define u3 (compound-unit (import (S1 : x-sig)) (export S4) + (link (((S4 : y-sub)) u1 S1)))) + (define u4 (compound-unit (import (S3 : y-sig)) (export S2) + (link (((S2 : x-sub)) u2 S3)))) + (define u5 (compound-unit (import (S2 : y-sub)) (export S1) + (link (((S1 : x-sig)) u2 S2)))) + (test '(3 4 2) + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : x-sig)) u2 S2) + (((S2 : y-sig)) u1 S1))))) + (test '(3 4 2) + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : x-sub)) u2 S2) + (((S2 : y-sub)) u1 S1))))) + + + (test '(3 4 2) + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : x-sub)) u4 S4) + (((S4 : y-sub)) u3 S1))))) + (test '(3 4 2) + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : x-sig)) u4 S4) + (((S4 : y-sig)) u3 S1))))) + + + (test '(3 4 2) + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : x-sig)) u5 S2) + (((S2 : y-sub)) u1 S1)))))) +(let () + (define u1 (unit (import) (export x-sig) (define x 1))) + (define u2 (unit (import x-sub) (export))) + + (test-runtime-error exn:fail:contract? "compound-unit: not a subtype" + (compound-unit (import) (export) + (link (((S : x-sub)) u1)))) + + (test-runtime-error exn:fail:contract? "compound-unit: not a subtype" + (compound-unit (import) (export) + (link (((S : x-sig)) u1) + (() u2 S)))) + + (test-runtime-error exn:fail:contract? "compound-unit: not a subtype" + (compound-unit (import (S : x-sig)) (export) + (link (() u2 S))))) + +(let () + (define u1 (unit (import) (export x-sub y-sub) (define x 1) (define xx 2) (define y 3) (define yy 4))) + (define-values/invoke-unit u1 (import) (export x-sig)) + (test 1 x) + (test-runtime-error exn? "unbound identifier" xx) + (test-runtime-error exn? "unbound identifier" y) + (test-runtime-error exn? "unbound identifier" yy)) + +(let () + (define u1 (unit (import) (export x-sig) (define x 1))) + (test-runtime-error exn:fail:contract? "define-values/invoke-unit: not a subtype" + (define-values/invoke-unit u1 (import) (export x-sub)))) + +;; export-subtyping +(test-syntax-error "duplicate exports (subtypes)" + (unit (import) (export x-sig x-sub) + (define x 1) + (define xx 1))) +(test-syntax-error "duplicate exports (subtypes)" + (unit (import) (export x-sub x-sig) + (define x 1) + (define xx 1))) +(let () + (define u (unit (import) (export x-sub) (define x 1) (define xx 1))) + (test-syntax-error "duplicate exports (subtypes)" + (compound-unit (import) (export l1 l2) + (link (((l1 : s1)) u) + (((l2 : s2)) u))))) +(let () + (define u (unit (import) (export x-sub (prefix x: x-sub2)) + (define x 1) + (define xx 2) + (define x:x 3) + (define x:x2 4))) + (define u2 (unit (import x-sig) (export))) + (define v (unit (import x-sub) (export) + (+ x xx))) + (define w (unit (import x-sub2) (export) + (+ x x2))) + (define u3 (unit (import x-sub (prefix m: x-sub2)) (export) + (+ x xx m:x m:x2))) + (test 3 + (invoke-unit + (compound-unit (import) (export) + (link (((S2 : x-sub)) u) + (() v S2))))) + (test 7 + (invoke-unit + (compound-unit (import) (export) + (link (((S3 : x-sub2)) u) + (() w S3))))) + (test 10 + (invoke-unit + (compound-unit (import) (export) + (link (((S3 : x-sub2) (S2 : x-sub)) u) + (() u3 S3 S2))))) + (test-runtime-error exn:fail:contract? "ambiguous export" + (compound-unit (import) (export) + (link (((S1 : x-sig)) u))))) + (test-runtime-error exn:fail:contract? "ambiguous import" + (compound-unit (import (S1 : x-sub) (S2 : x-sub2)) (export) + (link (() u2 S1 S2)))) + +(test-syntax-error "duplicate links (subtype)" + (compound-unit (import) (export) + (link (((S1 : x-sig)) u3) + (() u1 S2 S1) + (((S2 : x-sig)) u3)))) +;; tags +(let () + (define-signature s1 (a)) + (define-signature s2 extends s1 (b)) + (define-signature s3 extends s2 ()) + (define-signature s4 extends s3 ()) + (define u1 + (unit (import (prefix s1: s1) + (tag t (prefix s2: s2)) + (prefix bs1: s2) + (prefix bs2: s3)) + (export) + (list s1:a s2:a s2:b bs1:a bs2:b))) + (define u2 + (unit (import) (export s3) + (define a 1) (define b 2))) + (define u3 + (unit (import) (export s2) + (define a 3) (define b 4))) + (test '(1 3 4 1 2) + (invoke-unit + (compound-unit (import) (export) + (link (((S2a : s3)) u2) + (((S2b : s2)) u3) + (() u1 S2a (tag t S2b)))))) + (test-runtime-error exn:fail:contract? "compound-unit: signature mismatch" + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : s1)) u2) + (((S2 : s2)) u3) + (() u1 (tag t S1) S2)))))) +(let () + (define u1 + (unit (import) (export (prefix a: x-sig) (tag t (prefix c: x-sig))) + (define a:x 1) + (define c:x 4))) + (define u2 + (unit (import x-sig) (export) + x)) + (define u3 + (unit (import x-sub) (export) + (list x xx))) + + (test 4 + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : (tag t x-sig)) (S2 : x-sig)) u1) + (() u2 S1))))) + (test-runtime-error exn:fail:contract? "compound-unit: signature mismatch" + (invoke-unit + (compound-unit (import) (export) + (link (((S1 : (tag t x-sub)) (S2 : x-sub)) u1) + (() u2 S1))))) + ) + +(let () + (define u1 (unit (import) (export (tag t1 x-sig) (prefix : x-sig)) + (define x 10) + (define :x 11))) + (define-values/invoke-unit u1 (import) (export x-sig (tag t1 (prefix m x-sig)))) + (test '(11 10) + (list x mx))) + + +(define-signature s1 (x)) +(define-signature s2 (a x z)) + + +(test-syntax-error "unit-from-context: no sigs" + (unit-from-context)) +(test-syntax-error "unit-from-context: too many sigs" + (unit-from-context s1 s2)) +(test-syntax-error "unit-from-context: too many sigs" + (unit-from-context s1 . s2)) +(test-syntax-error "unit-from-context: bad sig" + (unit-from-context 1)) + +(test-syntax-error "unit-from-context: no name" + (define-unit-from-context)) +(test-syntax-error "unit-from-context: no sigs" + (define-unit-from-context s1)) +(test-syntax-error "unit-from-context: no sigs" + (define-unit-from-context n)) +(test-syntax-error "unit-from-context: too many sigs" + (define-unit-from-context n s1 s2)) +(test-syntax-error "unit-from-context: too many sigs" + (define-unit-from-context n s1 . s2)) +(test-syntax-error "unit-from-context: bad sig" + (define-unit-from-context n 1)) + + + +;; Test the struct form +(test-syntax-error "struct: missing name and fields" + (define-signature x ((struct)))) +(test-syntax-error "struct: missing name" + (define-signature x ((struct n)))) +(test-syntax-error "struct: bad name" + (define-signature x ((struct 1 ())))) +(test-syntax-error "struct: bad fields (dot)" + (define-signature x ((struct n (x . y))))) +(test-syntax-error "struct: bad fields" + (define-signature x ((struct n 1)))) +(test-syntax-error "struct: bad omission" + (define-signature x ((struct n () t)))) +(test-syntax-error "struct: bad omission (dot)" + (define-signature x ((struct n () . -selectors)))) +(test-syntax-error "struct: bad omission" + (define-signature x ((struct n () x)))) + +(require (lib "plt-match.ss")) +(let () + (define-signature sig ((struct s (x y)))) + (test 3 + (invoke-unit + (compound-unit (import) (export) + (link (((S : sig)) (unit (import) (export sig) + (define-struct s (x y)))) + (() (unit (import sig) (export) + (match (make-s 1 2) + ((struct s (a b)) (+ a b)))) + S))))) + (let () + (define-values/invoke-unit (unit (import) (export sig) (define-struct s (x y))) + (import) + (export sig)) + (test 3 + (match (make-s 1 2) + ((struct s (a b)) (+ a b))))) + (let () + (define u + (unit (import) (export (rename sig (make-s/defaults make-s))) + (define-struct s (x y)) + (define (make-s/defaults x) + (make-s x 'default)))) + (define-values/invoke-unit u (import) (export sig)) + (test #t (s? (make-s 1)))) + + (let ((set-s-x! 1)) + (define-signature sig ((struct s (x y) -setters))) + (test 1 + (invoke-unit + (compound-unit (import) (export) + (link (((S : sig)) (unit (import) (export sig) (define-struct s (x y)))) + (() (unit (import sig) (export) + set-s-x!) S)))))) + (let ((s-x 1)) + (define-signature sig ((struct s (x y) -selectors))) + (test 1 + (invoke-unit + (compound-unit (import) (export) + (link (((S : sig)) (unit (import) (export sig) (define-struct s (x y)))) + (() (unit (import sig) (export) + s-x) S))))))) + +;; Dependencies + +(define-signature s1 (a)) +(define-signature s2 extends s1 ()) + +(define u1 (unit (import s1) (export) (init-depend s1) + a)) +(define u2 (unit (import) (export s1) + (define a 12))) +(define u3 (unit (import (tag t s1)) (export) (init-depend (tag t s1)) + a)) + +(define u4 (compound-unit (import (L : s2)) (export) + (link (() u1 L)))) +(define u5 (unit (import) (export s2) + (define a 12))) +(test-syntax-error "unit: bad dependency" + (unit (import (tag t s1)) (export) (init-depend s1))) +(test-syntax-error "unit: bad dependency" + (unit (import s1) (export) (init-depend (tag t s1)))) + +(test 12 (invoke-unit (compound-unit (import) (export) + (link (((S1 : s1)) u2) + (() u1 S1))))) + +(test-runtime-error exn:fail:contract? "Dependency violation" + (compound-unit (import) (export) + (link (() u1 S1) + (((S1 : s1)) u2)))) + +(test-runtime-error exn:fail:contract? "Dependency violation" + (compound-unit (import) (export) + (link (() u3 (tag t S1)) + (((S1 : s1)) u2)))) + + + +(test-runtime-error exn:fail:contract? "Dependency violation" + (compound-unit (import) (export) + (link (() u4 S2) + (((S2 : s2)) u5)))) +;; Inference + + +(define u (unit (import x-sig) (export y-sig) (define y 0) x)) +(define v (unit (import) (export x-sig y-sig) (define x 9) (define y 10))) + +(test 9 + (let () + (define-unit-binding u2 u (import x-sig y-sig) (export)) + (invoke-unit + (compound-unit (import) (export) + (link (((A : x-sig) (B : y-sig)) v) + (() u A B)))))) + +(test-runtime-error exn:fail:contract? "not subunit" + (let () (define-unit-binding u2 u (import x-sig) (export x-sig)) 1)) +(test-runtime-error exn:fail:contract? "not subunit" + (let () (define-unit-binding u2 u (import) (export)) 1)) +(test-runtime-error exn:fail:contract? "not a unit" + (let () (define-unit-binding u2 1 (import) (export)) 1)) + +(test-syntax-error "define-unit-binding: duplicate import" + (define-unit-binding u 1 (import x-sig x-sig) (export))) +(test-syntax-error "define-unit-binding: export subtypes" + (define-unit-binding u 1 (import) (export x-sig x-sub))) +(test-syntax-error "define-unit-binding: export subtypes" + (define-unit-binding u 1 (import) (export x-sub x-sig))) +(test-syntax-error "define-unit-binding: bad dependency" + (define-unit-binding u 1 (import x-sig) (export) (init-depend x-sub))) +(test-syntax-error "define-unit-binding: bad dependency" + (define-unit-binding u 1 (import x-sub) (export) (init-depend x-sig))) + + +(test-syntax-error "define-unit: missing name, import, export" + (define-unit)) +(test-syntax-error "define-unit: missing import, export" + (define-unit a)) +(test-syntax-error "define-unit: missing export" + (define-unit a (import))) +(test-syntax-error "define-unit: missing name" + (define-unit (import) (export))) +(test-syntax-error "define-unit: bad name" + (define-unit "x" (import) (export))) +(test-syntax-error "define-unit: bad syntax" + (define-unit x (unit (import) (export)))) +(test-runtime-error exn:fail:contract? "define-unit: bad set!" + (let () + (define-signature s ()) + (define-unit x (import) (export) 1) + (set! x (unit (import s) (export) 1)))) +(test-runtime-error exn:fail:contract? "define-unit: bad set!" + (let () + (define-signature s ()) + (define-unit x (import) (export s) 1) + (set! x (unit (import) (export) 1)))) + + +(test-syntax-error "define-compound-unit: missing import" + (define-compound-unit x)) +(test-syntax-error "define-compound-unit: missing name" + (define-compound-unit)) +(test-syntax-error "define-compound-unit: missing name" + (define-compound-unit (import) (link) (export))) +(test-syntax-error "define-compound-unit: bad name" + (define-compound-unit 1 (import) (link) (export))) + +(test-syntax-error "define-values/invoke-unit/infer: no unit" + (define-values/invoke-unit/infer)) +(test-syntax-error "define-values/invoke-unit/infer: not a unit" + (define-values/invoke-unit/infer 1)) +(test-syntax-error "define-values/invoke-unit/infer: not a unit" + (let ((x 1)) + (define-values/invoke-unit/infer x))) +(test-syntax-error "define-values/invoke-unit/infer: not a unit" + (let-syntax ((x 1)) + (define-values/invoke-unit/infer x))) +(test-syntax-error "define-values/invoke-unit/infer: too much" + (define-values/invoke-unit/infer x y)) + +(define-unit u (import x-sig) (export)) +(test-syntax-error "define-values/invoke-unit/infer: bad imports" + (define-values/invoke-unit/infer u)) +(define-unit u (import x-sig y-sig) (export)) +(test-syntax-error "define-values/invoke-unit/infer: bad imports" + (define-values/invoke-unit/infer u)) +(define-unit u (import) (export x-sig y-sig) + (define x 10) + (define y 20)) +(test 30 + (let () + (define-values/invoke-unit/infer u) + (+ y x))) + + +(test 1 + (let () + (define-unit x (import) (export) 1) + (invoke-unit x))) +(test 1 + (let () + (define-unit x (import) (export) 1) + (let ((u 1)) + (invoke-unit x)))) +(test 2 + (let () + (define-unit x (import) (export) 1) + (set! x (unit (import) (export) 2)) + (invoke-unit x))) + + + +(let () + (define-signature s1 (a)) + (define-signature s2 extends s1 (b)) + (define-signature s3 (c)) + (define-signature s4 extends s3 (d)) + (define-unit u (import s2) (export s3) (define c (+ a b))) + (define-unit v (import) (export s2) (define a 1) (define b 3)) + (set! u (unit (import s1) (export s4) (define c (add1 a)) (define d 12))) + (let () + (define-values/invoke-unit (compound-unit/infer (import) (export s2 s3) (link v u)) + (import) (export s2 s3)) + (test '(1 3 2) (list a b c)))) + + +(test-syntax-error "compound-unit/infer: missing export" + (compound-unit/infer (link) (import))) +(test-syntax-error "compound-unit/infer: bad unit" + (compound-unit/infer (import) (export) (link 1))) +(test-syntax-error "compound-unit/infer: bad import" + (compound-unit/infer (import (a : b)) (export) (link))) +(test-syntax-error "compound-unit/infer: bad link" + (compound-unit/infer (import) (export) (link (((A : b)) c)))) +(test-syntax-error "compound-unit/infer: unknown sig" + (compound-unit/infer (import ??) (export) (link))) +(test-syntax-error "compound-unit/infer: unknown sig" + (compound-unit/infer (import) (export ??) (link))) +(test-syntax-error "compound-unit/infer: unknown sig" + (compound-unit/infer (import) (export) (link (() u ??)))) + + +(define-unit x + (import x-sig) + (export y-sig) + (define y x) + y) + +(define-unit y + (import y-sig) + (export (rename x-sig (x x))) + (define x y) + x) + +(define-unit z + (import (prefix : x-sig) y-sig) + (export) + (+ :x y)) + +(define-unit a + (import) + (export x-sig y-sig z-sig) + (define x 1) + (define y 2) + (define z 3)) + +(define-unit b + (import x-sig y-sig z-sig) + (export) + (+ x y z)) + +(test-syntax-error "compound-unit/infer: re-export" + (compound-unit/infer (import (l : x-sig)) (export x-sig) (link))) +(test-syntax-error "compound-unit/infer: duplicate def and import" + (compound-unit/infer (import y-sig x-sig) (export) (link x y))) +(test-syntax-error "compound-unit/infer: unprovided sig" + (compound-unit/infer (import) (export) (link x))) +(test-syntax-error "compound-unit/infer: unprovided sig" + (compound-unit/infer (import) (export x-sig) (link))) + +(test (letrec ((x x)) x) + (invoke-unit + (compound-unit/infer (import) (export) + (link x y)))) + +(test 3 + (let () + (define-signature s (x y)) + (let ((x 1) + (y 2)) + (define-unit-from-context u1 s) + (define-unit u2 (import (prefix : s)) (export) + (+ :x :y)) + (invoke-unit + (compound-unit/infer (import) (export) + (link u1 u2)))))) +(test 6 + (invoke-unit + (compound-unit/infer (import) (export) + (link (((L1 : y-sig)) a) + x + (() b L1))))) + +(let () + (define-unit u1 (import (tag t x-sig)) (export) + (add1 x)) + (define-unit u2 (import) (export x-sig) + (define x 2)) + (test 3 + (invoke-unit + (compound-unit/infer (import) (export) + (link u2 u1))))) +(let () + (define-unit u1 (import x-sig) (export) + (add1 x)) + (define-unit u2 (import) (export (tag u x-sig)) + (define x 2)) + (test 3 + (invoke-unit + (compound-unit/infer (import) (export) + (link u2 u1))))) + +(let () + (define-unit x2 (import) (export x-sig) (define x 44)) + (define-unit x3 (import) (export x-sig) (define x 4400)) + (define-unit z (import x-sig) (export z-sig) (define z (+ 100 x))) + (define-compound-unit/infer u (import (L : x-sig)) (export L2 y-sig) + (link x3 (((L2 : z-sig)) z L) (() a L))) + (test 190 + (invoke-unit + (compound-unit/infer (import) (export) + (link x2 u b))))) + +(let () + (define-unit u (import x-sig) (export)) + (define-unit v (import) (export x-sub) (define x 12) (define xx 13)) + (define-compound-unit/infer c (import) (export x-sig) (link v u)) + (define-values/invoke-unit/infer c) + (test 12 x)) + + +(let () + (define-unit u (import) (export x-sig) + (define x 12)) + (define-unit u2 (import) (export x-sig) + (define x 13)) + (define-unit v (import) (export y-sig) + (define y 11)) + (define-unit v2 (import) (export y-sig) + (define y 1)) + (define-unit u3 (import y-sig x-sig) (export) + (+ y x)) + (test 24 + (invoke-unit + (compound-unit/infer (import) (export) + (link (((l : x-sig)) u) + (((l2 : x-sig)) u2) + (((l3 : y-sig)) v) + (((l4 : y-sig)) v2) + (() u3 l2 l3)))))) + +;; unit/new-import-export + +(test-runtime-error exn:fail:contract? "unit/new-import-export: not a unit" + (unit/new-import-export (import) (export) + (() 1))) + +(test-runtime-error exn:fail:contract? "unit/new-import-export: not a subtype" + (unit/new-import-export (import) (export) + ((x-sig) (unit (import) (export))))) + + +(test-runtime-error exn:fail:contract? "unit/new-import-export: not a subtype" + (unit/new-import-export (import) (export) + (() (unit (import x-sig) (export))))) + +(define-unit u (import x-sig) (export y-sig) + (define y x)) + +(test-syntax-error "unit/new-import-export: not enough imports" + (unit/new-import-export (import) (export x-sig) + ((y-sig) u x-sig))) + +(test-syntax-error "unit/new-import-export: too many exports" + (unit/new-import-export (import x-sig) (export y-sig z-sig) + ((y-sig) u x-sig))) + +(let () + (define-unit u + (import xy-sig) (export z-sig) + (define z (+ x y))) + (define-unit v + (import) (export x-sig y-sig) + (define x 4) + (define y 8)) + (define-unit w (import z-sig) (export) + z) + (define-unit/new-import-export u2 (import x-sig y-sig) (export z-sig) + ((z-sig) u xy-sig)) + (test 12 + (invoke-unit (compound-unit/infer (import) (export) + (link v u2 w))))) + +(let () + (define-unit u + (import x-sig y-sig) (export z-sig) + (define z (+ x y))) + (define-unit v + (import) (export xy-sig) + (define x 4) + (define y 8)) + (define-unit w (import z-sig) (export) + z) + (define-unit/new-import-export u2 (import xy-sig) (export z-sig) + ((z-sig) u y-sig x-sig)) + (test 12 + (invoke-unit (compound-unit/infer (import) (export) + (link v u2 w))))) + +(let () + (define-unit u + (import xy-sig) (export z-sig) + (define z (+ x y))) + (define-unit v + (import) (export x-sig y-sig) + (define x 4) + (define y 8)) + (define-unit w (import z-sig) (export) + z) + (define-unit/new-import-export v2 (import) (export xy-sig) + ((x-sig y-sig) v)) + (test 12 + (invoke-unit (compound-unit/infer (import) (export) + (link v2 u w))))) + +(let () + (define-unit u + (import x-sig y-sig) (export z-sig) + (define z (+ x y))) + (define-unit v + (import) (export xy-sig) + (define x 4) + (define y 8)) + (define-unit w (import z-sig) (export) + z) + (define-unit/new-import-export v2 (import) (export y-sig x-sig) + ((xy-sig) v)) + (test 12 + (invoke-unit (compound-unit/infer (import) (export) + (link v2 u w))))) + + + + +;; open +(let () + (define-signature xzy + ((open x-sig) (open y-sig) (open z-sig))) + + (define-unit u (import xzy) (export) + (+ x z y)) + + (define-unit v (import) (export xzy) + (define x 10) + (define y 20) + (define z 30)) + + (test 60 + (invoke-unit (compound-unit/infer (import) (export) (link v u))))) + +(let ([x 1] + [y 2] + [z 3]) + (define-signature xzy + ((open x-sig) (open y-sig) (open z-sig))) + + (define-unit u (import xzy) (export) + (+ x z y)) + + (define-unit v (import) (export xzy) + (define x 10) + (define y 20) + (define z 30)) + + (test 60 + (invoke-unit (compound-unit/infer (import) (export) (link v u))))) + +(define-signature s + (x (define-values (y) (add1 x)))) + +(let ([x 1] + [y 10] + [s:x 100] + [s:y 1000]) + (define-signature s2 + ((open (prefix s: s)) x (define-values (y) (sub1 x)))) + (define-unit u1 (import s2) (export) + (list s:x s:y x y)) + (define-unit u2 (import) (export s2) + (define s:x 3) + (define x 19)) + (test '(3 4 19 18) + (invoke-unit (compound-unit/infer (import) (export) (link u2 u1))))) diff --git a/collects/texpict/code.ss b/collects/texpict/code.ss index 0beae93a10..00be00f7c5 100644 --- a/collects/texpict/code.ss +++ b/collects/texpict/code.ss @@ -3,7 +3,7 @@ (lib "class.ss") (lib "list.ss") (lib "mred.ss" "mred") - (lib "unitsig.ss")) + (lib "unit.ss")) (provide define-code code^ code-params^ code@) @@ -117,9 +117,9 @@ [(x (... ...)) ,illegal-use-of-once] [x (get-val)])))])) - (define code@ - (unit/sig code^ + (define-unit code@ (import code-params^) + (export code^) (define (default-tt s) (text s `(bold . modern) (current-font-size))) @@ -528,4 +528,4 @@ (tt (format "~s" (syntax-e stx))) )) closes)]))) - ))) + )) diff --git a/collects/texpict/mrpict-sig.ss b/collects/texpict/mrpict-sig.ss index 900cc51409..34dffb24c7 100644 --- a/collects/texpict/mrpict-sig.ss +++ b/collects/texpict/mrpict-sig.ss @@ -1,6 +1,6 @@ (module mrpict-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "private/common-sig.ss") (require "private/mrpict-sig.ss") diff --git a/collects/texpict/mrpict-unit.ss b/collects/texpict/mrpict-unit.ss index 58ce122ffb..331efdddca 100644 --- a/collects/texpict/mrpict-unit.ss +++ b/collects/texpict/mrpict-unit.ss @@ -1,6 +1,6 @@ (module mrpict-unit mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "mred-sig.ss" "mred")) @@ -10,18 +10,7 @@ "private/mrpict-extra.ss") (provide mrpict@) - (define mrpict@ - (compound-unit/sig - (import (MRED : mred^)) - (link [COMMON : ((open texpict-common^) - (open texpict-internal^)) - (common@ - (MRPICTX : texpict-common-setup^))] - [MRPICTX : ((open mrpict-extra^) - (open texpict-common-setup^)) - (mrpict-extra@ - MRED - COMMON)]) - (export (open (COMMON : texpict-common^)) - (open (MRPICTX : mrpict-extra^)))))) - + (define-compound-unit/infer mrpict@ + (import mred^) + (export texpict-common^ mrpict-extra^) + (link common@ mrpict-extra@))) \ No newline at end of file diff --git a/collects/texpict/mrpict.ss b/collects/texpict/mrpict.ss index bff9ba5b89..1cdc43cb58 100644 --- a/collects/texpict/mrpict.ss +++ b/collects/texpict/mrpict.ss @@ -1,16 +1,19 @@ (module mrpict mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require (lib "mred-sig.ss" "mred") - (lib "mred.ss" "mred")) - + (lib "mred-unit.ss" "mred")) + (require "private/mrpict-sig.ss" + "private/common-sig.ss") (require "mrpict-sig.ss" "mrpict-unit.ss") - (define-values/invoke-unit/sig mrpict^ - mrpict@ - #f - mred^) + (define-compound-unit/infer mrpict+mred@ + (import) + (export texpict-common^ mrpict-extra^) + (link standard-mred@ mrpict@)) + + (define-values/invoke-unit/infer mrpict+mred@) - (provide-signature-elements mrpict^)) + (provide-signature-elements texpict-common^ mrpict-extra^)) diff --git a/collects/texpict/private/common-sig.ss b/collects/texpict/private/common-sig.ss index e6915e8163..f755b91cbd 100644 --- a/collects/texpict/private/common-sig.ss +++ b/collects/texpict/private/common-sig.ss @@ -1,5 +1,5 @@ (module common-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide texpict-common^) (define-signature texpict-common^ diff --git a/collects/texpict/private/common-unit.ss b/collects/texpict/private/common-unit.ss index f8c2df4930..24d3be69bc 100644 --- a/collects/texpict/private/common-unit.ss +++ b/collects/texpict/private/common-unit.ss @@ -1,14 +1,11 @@ -(module common-unit mzscheme - (require (lib "unitsig.ss") - (lib "etc.ss")) +(module common-unit (lib "a-unit.ss") + (require (lib "etc.ss")) (require "common-sig.ss") - (provide common@) - (define common@ - (unit/sig ((open texpict-common^) (open texpict-internal^)) - (import texpict-common-setup^) + (import texpict-common-setup^) + (export texpict-common^ texpict-internal^) (define default-seg 5) (define recordseplinespace 4) @@ -954,4 +951,4 @@ [(prog) `((prog ,(cadr s) ,(caddr s)))] [else (error 'pict->commands "bad tag: ~s" tag)]))))) - ))) + ) diff --git a/collects/texpict/private/mrpict-extra.ss b/collects/texpict/private/mrpict-extra.ss index f4f3c10e2c..25f23433f3 100644 --- a/collects/texpict/private/mrpict-extra.ss +++ b/collects/texpict/private/mrpict-extra.ss @@ -1,7 +1,6 @@ -(module mrpict-extra mzscheme - (require (lib "unitsig.ss") - (lib "class.ss") +(module mrpict-extra (lib "a-unit.ss") + (require (lib "class.ss") (lib "etc.ss")) (require (lib "mred-sig.ss" "mred")) @@ -9,13 +8,11 @@ (require "mrpict-sig.ss" "common-sig.ss") - (provide mrpict-extra@) - (define mrpict-extra@ - (unit/sig ((open mrpict-extra^) - (open texpict-common-setup^)) - (import mred^ - ((open texpict-common^) - (open texpict-internal^))) + (import mred^ + texpict-common^ + texpict-internal^) + (export mrpict-extra^ + texpict-common-setup^) (define show-pict (opt-lambda (p [w #f] [h #f]) @@ -418,4 +415,4 @@ dx 0)))) (define (draw-pict p dc dx dy) - ((make-pict-drawer p) dc dx dy))))) + ((make-pict-drawer p) dc dx dy))) diff --git a/collects/texpict/private/mrpict-sig.ss b/collects/texpict/private/mrpict-sig.ss index 16430736a5..851211200d 100644 --- a/collects/texpict/private/mrpict-sig.ss +++ b/collects/texpict/private/mrpict-sig.ss @@ -1,6 +1,6 @@ (module mrpict-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide mrpict-extra^) (define-signature mrpict-extra^ diff --git a/collects/texpict/private/texpict-extra.ss b/collects/texpict/private/texpict-extra.ss index 6a9f4f9de0..ab7e910da9 100644 --- a/collects/texpict/private/texpict-extra.ss +++ b/collects/texpict/private/texpict-extra.ss @@ -1,18 +1,15 @@ -(module texpict-extra mzscheme - (require (lib "unitsig.ss") - (lib "etc.ss") +(module texpict-extra (lib "a-unit.ss") + (require (lib "etc.ss") (lib "list.ss")) (require "texpict-sig.ss" "common-sig.ss") - (provide texpict-extra@) - (define texpict-extra@ - (unit/sig ((open texpict-extra^) - (open texpict-common-setup^)) - (import ((open texpict-common^) - (open texpict-internal^))) + (import texpict-common^ + texpict-internal^) + (export texpict-extra^ + texpict-common-setup^) (define using-pict2e-package (make-parameter #f @@ -466,5 +463,5 @@ (error 'pict->string "cannot handle prog pict")] [else (error 'pict->string "bad tag: ~s" tag)]))))) - (define pict->commands pict->command-list)))) + (define pict->commands pict->command-list)) diff --git a/collects/texpict/private/texpict-sig.ss b/collects/texpict/private/texpict-sig.ss index 0c5a3ac9c0..ec794bdbdc 100644 --- a/collects/texpict/private/texpict-sig.ss +++ b/collects/texpict/private/texpict-sig.ss @@ -1,6 +1,6 @@ (module texpict-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (provide texpict-extra^) (define-signature texpict-extra^ diff --git a/collects/texpict/texpict-sig.ss b/collects/texpict/texpict-sig.ss index baa7703d20..8095057e94 100644 --- a/collects/texpict/texpict-sig.ss +++ b/collects/texpict/texpict-sig.ss @@ -1,6 +1,6 @@ (module texpict-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "private/common-sig.ss") (require "private/texpict-sig.ss") diff --git a/collects/texpict/texpict-unit.ss b/collects/texpict/texpict-unit.ss index 913568ab50..4011711d09 100644 --- a/collects/texpict/texpict-unit.ss +++ b/collects/texpict/texpict-unit.ss @@ -1,6 +1,6 @@ (module texpict-unit mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "private/texpict-sig.ss" "private/common-sig.ss" @@ -8,18 +8,9 @@ "private/texpict-extra.ss") (provide texpict@) - (define texpict@ - (compound-unit/sig - (import) - (link - [common : ((open texpict-common^) - (open texpict-internal^)) - (common@ - (texpictx : texpict-common-setup^))] - [texpictx : ((open texpict-extra^) - (open texpict-common-setup^)) - (texpict-extra@ - common)]) - (export (open (common : texpict-common^)) - (open (texpictx : texpict-extra^)))))) + (define-compound-unit/infer texpict@ + (import) + (export texpict-common^ + texpict-extra^) + (link common@ texpict-extra@))) diff --git a/collects/texpict/texpict.ss b/collects/texpict/texpict.ss index d3a337e971..675401d1d7 100644 --- a/collects/texpict/texpict.ss +++ b/collects/texpict/texpict.ss @@ -1,12 +1,13 @@ (module texpict mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "texpict-sig.ss" "texpict-unit.ss") + (require "private/texpict-sig.ss" + "private/common-sig.ss") + (define-values/invoke-unit/infer texpict@) - (define-values/invoke-unit/sig texpict^ - texpict@) - - (provide-signature-elements texpict^)) + (provide-signature-elements texpict-common^ + texpict-extra^)) diff --git a/collects/trace/calltrace-lib.ss b/collects/trace/calltrace-lib.ss index db0081ca0a..b22f1ab15b 100644 --- a/collects/trace/calltrace-lib.ss +++ b/collects/trace/calltrace-lib.ss @@ -6,7 +6,7 @@ (require "stacktrace.ss" (lib "list.ss") (lib "etc.ss") - (lib "unitsig.ss")) + (lib "unit.ss")) @@ -68,8 +68,9 @@ (define calltrace-key #`(quote #,(gensym 'key))) - (define-values/invoke-unit/sig stacktrace^ stacktrace@ #f stacktrace-imports^) - + (define-values/invoke-unit stacktrace@ + (import stacktrace-imports^) (export stacktrace^)) + (provide calltrace-eval-handler instrumenting-enabled annotate)) diff --git a/collects/trace/stacktrace.ss b/collects/trace/stacktrace.ss index 72b6e1a157..5750bf670a 100644 --- a/collects/trace/stacktrace.ss +++ b/collects/trace/stacktrace.ss @@ -1,6 +1,6 @@ (module stacktrace mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "kerncase.ss" "syntax") (lib "stx.ss" "syntax")) @@ -14,10 +14,10 @@ (define-struct stx-protector (stx)) - (define stacktrace@ - (unit/sig stacktrace^ - (import stacktrace-imports^) - + (define-unit stacktrace@ + (import stacktrace-imports^) + (export stacktrace^) + ;; TEMPLATE FUNCTIONS: ;; these functions' definitions follow the data definitions presented in the Syntax ;; chapter of the MzScheme Manual. @@ -174,4 +174,4 @@ (loop #'rest (cons #'var so-far))]))) - (define (annotate x) (top-level-expr-iterator x))))) + (define (annotate x) (top-level-expr-iterator x)))) diff --git a/collects/version/tool.ss b/collects/version/tool.ss index 4f6bc12032..2bacc53659 100644 --- a/collects/version/tool.ss +++ b/collects/version/tool.ss @@ -1,6 +1,6 @@ (module tool mzscheme (require (lib "tool.ss" "drscheme") - (lib "unitsig.ss") + (lib "unit.ss") (lib "framework.ss" "framework") (lib "mred.ss" "mred") (lib "class.ss") @@ -163,8 +163,9 @@ (provide tool@) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (preferences:add-to-warnings-checkbox-panel diff --git a/collects/web-server/configuration.ss b/collects/web-server/configuration.ss index 04129a3fd1..c8b74d3aa1 100644 --- a/collects/web-server/configuration.ss +++ b/collects/web-server/configuration.ss @@ -1,5 +1,5 @@ (module configuration mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "kw.ss") (lib "list.ss") (lib "contract.ss")) @@ -46,6 +46,7 @@ (directory-part default-configuration-table-path) (parse-configuration-table s-expr))) + ; : (listof (cons sym TST)) -> configuration ; more here - this is ugly. It also does not catch "unbound identifiers" since I use symbols. ; I considered several other solutions: @@ -53,20 +54,28 @@ ; - use opt-lambda and pass in 'please-use-the-default for unchanged flags ; - write three different functional updaters and re-compound the unit 1--3 times (define (update-configuration configuration flags) - (compound-unit/sig + + (define-unit new-local-config@ + (import (prefix raw: web-config/local^)) + (export web-config/local^) + (init-depend web-config/local^) + + (define port (extract-flag 'port flags raw:port)) + (define listen-ip (extract-flag 'ip-address flags raw:listen-ip)) + (define instances (extract-flag 'instances flags raw:instances)) + (define make-servlet-namespace (extract-flag 'namespace flags raw:make-servlet-namespace))) + + (define-unit/new-import-export config@ (import) (export web-config/local^ web-config/pervasive^) + ((web-config^) configuration)) + + (define-compound-unit/infer new-config@ (import) - (link - [config : web-config^ (configuration)] - [new-config : web-config/local^ - ((unit/sig web-config/local^ - (import (raw : web-config/local^)) - (define port (extract-flag 'port flags raw:port)) - (define listen-ip (extract-flag 'ip-address flags raw:listen-ip)) - (define instances (extract-flag 'instances flags raw:instances)) - (define make-servlet-namespace (extract-flag 'namespace flags raw:make-servlet-namespace))) - (config : web-config/local^))]) - (export (open (config : web-config/pervasive^)) - (open (new-config : web-config/local^))))) + (export NL web-config/pervasive^) + (link (((L : web-config/local^)) config@) + (((NL : web-config/local^)) new-local-config@ L))) + + (unit/new-import-export (import) (export web-config^) + ((web-config/local^ web-config/pervasive^) new-config@))) (provide ; XXX contract make-make-servlet-namespace diff --git a/collects/web-server/dispatchers/dispatch-servlets.ss b/collects/web-server/dispatchers/dispatch-servlets.ss index d6b412ca60..efa55d13f4 100644 --- a/collects/web-server/dispatchers/dispatch-servlets.ss +++ b/collects/web-server/dispatchers/dispatch-servlets.ss @@ -2,7 +2,7 @@ (require (lib "url.ss" "net") (lib "kw.ss") (lib "plt-match.ss") - (lib "unitsig.ss") + (lib "unit.ss") (lib "contract.ss")) (require "dispatch.ss" "../private/web-server-structs.ss" @@ -281,7 +281,10 @@ (define (load-servlet/path a-path) (define (v0.servlet->v1.lambda servlet) (lambda (initial-request) - (invoke-unit/sig servlet servlet^))) + (invoke-unit + (compound-unit (import) (export) + (link (((S : servlet^)) (unit-from-context servlet^)) + (() servlet S)))))) (define (v0.response->v1.lambda response-path response) (define go (box @@ -301,7 +304,7 @@ (cond ;; signed-unit servlet ; MF: I'd also like to test that s has the correct import signature. - [(unit/sig? s) + [(unit? s) (make-servlet (current-custodian) (current-namespace) (create-timeout-manager diff --git a/collects/web-server/private/configuration-structures.ss b/collects/web-server/private/configuration-structures.ss index 26488a6f6e..d2a7bea244 100644 --- a/collects/web-server/private/configuration-structures.ss +++ b/collects/web-server/private/configuration-structures.ss @@ -1,5 +1,5 @@ (module configuration-structures mzscheme - (require (lib "unitsig.ss") + (require (only (lib "unit.ss") unit?) (lib "contract.ss") (lib "url.ss" "net")) (require "configuration-table-structs.ss" @@ -8,7 +8,7 @@ ; configuration is now a unit. See sig.ss ; XXX contract (define configuration? - unit/sig?) + unit?) ; host = (make-host (listof str) sym string ; passwords responders timeouts paths) diff --git a/collects/web-server/private/configuration.ss b/collects/web-server/private/configuration.ss index 8510f7862b..301bab1cf7 100644 --- a/collects/web-server/private/configuration.ss +++ b/collects/web-server/private/configuration.ss @@ -1,5 +1,5 @@ (module configuration mzscheme - (require (lib "unitsig.ss") + (require (lib "unit.ss") (lib "kw.ss") (lib "list.ss") (lib "contract.ss")) @@ -37,8 +37,9 @@ #:key [make-servlet-namespace default-make-servlet-namespace]) (define the-make-servlet-namespace make-servlet-namespace) - (unit/sig web-config^ + (unit (import) + (export web-config^) (define port (configuration-table-port table)) (define max-waiting (configuration-table-max-waiting table)) (define listen-ip #f) ; more here - add to configuration table diff --git a/collects/web-server/private/dispatch-server-sig.ss b/collects/web-server/private/dispatch-server-sig.ss index 083a5220ce..af7a23821a 100644 --- a/collects/web-server/private/dispatch-server-sig.ss +++ b/collects/web-server/private/dispatch-server-sig.ss @@ -1,5 +1,5 @@ (module dispatch-server-sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (define-signature dispatch-server^ (serve diff --git a/collects/web-server/private/dispatch-server-unit.ss b/collects/web-server/private/dispatch-server-unit.ss index d182817988..0ff0e9e1dc 100644 --- a/collects/web-server/private/dispatch-server-unit.ss +++ b/collects/web-server/private/dispatch-server-unit.ss @@ -1,22 +1,16 @@ -(module dispatch-server-unit mzscheme +(module dispatch-server-unit (lib "a-unit.ss") (require (lib "tcp-sig.ss" "net") - (lib "unitsig.ss") (lib "thread.ss") (lib "contract.ss") (lib "kw.ss")) (require "web-server-structs.ss" "connection-manager.ss" "dispatch-server-sig.ss") - - (provide/contract - ; XXX contract - [dispatch-server@ unit/sig?]) - + ;; **************************************** - (define dispatch-server@ - (unit/sig dispatch-server^ - (import net:tcp^ (config : dispatch-server-config^)) - + (import tcp^ (prefix config: dispatch-server-config^)) + (export dispatch-server^) + ;; serve: -> -> void ;; start the server and return a thunk to shut it down (define (serve) @@ -78,4 +72,4 @@ (set-connection-close?! conn close?)) (cond [(connection-close? conn) (kill-connection! conn)] - [else (connection-loop)]))))))) \ No newline at end of file + [else (connection-loop)]))))) \ No newline at end of file diff --git a/collects/web-server/sig.ss b/collects/web-server/sig.ss index fe119de4e8..f5d92c4e22 100644 --- a/collects/web-server/sig.ss +++ b/collects/web-server/sig.ss @@ -1,10 +1,11 @@ (module sig mzscheme - (require (lib "unitsig.ss")) + (require (lib "unit.ss")) (require "private/dispatch-server-sig.ss") (provide ; XXX contract signature - web-server^ servlet^ web-config^ web-config/pervasive^ web-config/local^) + (rename dispatch-server^ web-server^) + servlet^ web-config^ web-config/pervasive^ web-config/local^) - (define-signature web-server^ + #;(define-signature web-server^ ((open dispatch-server^))) (define-signature servlet^ diff --git a/collects/web-server/tools/servlet-env.ss b/collects/web-server/tools/servlet-env.ss index 3a255f71a7..ccf0c8592f 100644 --- a/collects/web-server/tools/servlet-env.ss +++ b/collects/web-server/tools/servlet-env.ss @@ -1,6 +1,6 @@ (module servlet-env mzscheme (require (lib "sendurl.ss" "net") - (lib "unitsig.ss")) + (lib "unit.ss")) (require "../configuration.ss" "../web-server.ss" "../sig.ss" @@ -53,7 +53,9 @@ (define (build-standalone-servlet-configuration the-port the-path the-servlet) (let ([basic-configuration@ (load-developer-configuration default-configuration-table-path)] [the-scripts (make-cache-table)]) - (define-values/invoke-unit/sig web-config^ basic-configuration@ i) + (define-values/invoke-unit basic-configuration@ + (import) + (export (prefix i: web-config^))) (cache-table-lookup! the-scripts (string->symbol (path->string @@ -69,8 +71,9 @@ (body (p "Return to the interaction window.")))) 30 30) the-servlet))) - (unit/sig web-config^ + (unit (import) + (export web-config^) (define port the-port) (define max-waiting i:max-waiting) (define listen-ip i:listen-ip) diff --git a/collects/web-server/web-server-unit.ss b/collects/web-server/web-server-unit.ss index 86f959bb45..166a3b5f5a 100644 --- a/collects/web-server/web-server-unit.ss +++ b/collects/web-server/web-server-unit.ss @@ -1,7 +1,7 @@ (module web-server-unit mzscheme (require (lib "tcp-sig.ss" "net") (lib "contract.ss") - (lib "unitsig.ss")) + (lib "unit.ss")) (require "sig.ss" "private/dispatch-server-unit.ss" "private/dispatch-server-sig.ss" @@ -17,13 +17,17 @@ (prefix path-procedure: "dispatchers/dispatch-pathprocedure.ss") (prefix log: "dispatchers/dispatch-log.ss") (prefix host: "dispatchers/dispatch-host.ss")) - (provide/contract + + (provide web-server@) + + #;(provide/contract ; XXX contract - [web-server@ unit/sig?]) + [web-server@ unit?]) - (define web-config@->dispatch-server-config@ - (unit/sig dispatch-server-config^ - (import (config : web-config^)) + (define-unit web-config@->dispatch-server-config@ + (import (prefix config: web-config^)) + (export dispatch-server-config^) + (init-depend web-config^) (define read-request the-read-request) (define port config:port) @@ -67,14 +71,10 @@ (files:make #:htdocs-path (paths-htdocs (host-paths host-info)) #:mime-types-path (paths-mime-types (host-paths host-info)) #:indices (host-indices host-info) - #:file-not-found-responder (responders-file-not-found (host-responders host-info))))))) + #:file-not-found-responder (responders-file-not-found (host-responders host-info)))))) + + (define-compound-unit/infer web-server@ + (import tcp^ web-config^) + (export web-server^) + (link web-config@->dispatch-server-config@ dispatch-server@))) - (define web-server@ - (compound-unit/sig - (import (TCP : net:tcp^) - (CONFIG : web-config^)) - (link (DISPATCH-CONFIG : dispatch-server-config^ - (web-config@->dispatch-server-config@ CONFIG)) - (DISPATCH : dispatch-server^ - (dispatch-server@ TCP DISPATCH-CONFIG))) - (export (open (DISPATCH : web-server^)))))) \ No newline at end of file diff --git a/collects/web-server/web-server.ss b/collects/web-server/web-server.ss index 6d8e21f8d7..500afee77d 100644 --- a/collects/web-server/web-server.ss +++ b/collects/web-server/web-server.ss @@ -1,6 +1,6 @@ (module web-server mzscheme (require (lib "tcp-sig.ss" "net") - (lib "unitsig.ss") + (lib "unit.ss") (lib "contract.ss") "sig.ss" "web-server-unit.ss" @@ -21,17 +21,17 @@ [(config port listen-ip) (run-the-server (update-configuration config `((port . ,port) (ip-address . ,listen-ip))))])) + (define-unit-from-context tcp@ tcp^) + + (define-unit m@ (import web-server^) (export) + (init-depend web-server^) + (serve)) + ; : configuration -> -> void (define (run-the-server config) - (invoke-unit/sig - (compound-unit/sig - (import (t : net:tcp^)) - (link - [c : web-config^ (config)] - [s : web-server^ (web-server@ t c)] - [m : () ((unit/sig () - (import web-server^) - (serve)) - s)]) - (export)) - net:tcp^))) \ No newline at end of file + (define-unit-binding c@ config (import) (export web-config^)) + (invoke-unit + (compound-unit/infer + (import) + (link tcp@ c@ web-server@ m@) + (export))))) \ No newline at end of file diff --git a/collects/xml/text-box-tool.ss b/collects/xml/text-box-tool.ss index d3180430dd..78fd796005 100644 --- a/collects/xml/text-box-tool.ss +++ b/collects/xml/text-box-tool.ss @@ -2,7 +2,7 @@ (require (lib "tool.ss" "drscheme") (lib "mred.ss" "mred") (lib "framework.ss" "framework") - (lib "unitsig.ss") + (lib "unit.ss") (lib "class.ss") (lib "contract.ss") (lib "string-constant.ss" "string-constants") @@ -34,9 +34,9 @@ x)) (define tool@ - (unit/sig drscheme:tool-exports^ + (unit (import drscheme:tool^) - + (export drscheme:tool-exports^) (define (phase1) (void)) (define (phase2) (void)) diff --git a/doc/release-notes/mzscheme/HISTORY b/doc/release-notes/mzscheme/HISTORY index c3185d2047..74b4af7b2d 100644 --- a/doc/release-notes/mzscheme/HISTORY +++ b/doc/release-notes/mzscheme/HISTORY @@ -1,3 +1,8 @@ +Version 360.3 +Changed dyanmic-require to expand requests for exported syntax + bindings +Added vector->values + Version 360.2 Added support for manipulating filesystem paths that work on other platforms diff --git a/src/mred/wxme/wx_keym.cxx b/src/mred/wxme/wx_keym.cxx index cd9f283d95..583111fd29 100644 --- a/src/mred/wxme/wx_keym.cxx +++ b/src/mred/wxme/wx_keym.cxx @@ -590,7 +590,7 @@ void wxKeymap::MapFunction(char *keys, char *fname) #endif code = toupper(code); } else if (isupper(code)) - shift = TRUE; + shift = 1; } num_new_keys = num_keys; diff --git a/src/mzscheme/dynsrc/start.c b/src/mzscheme/dynsrc/start.c index 7796d109a1..2f91100029 100644 --- a/src/mzscheme/dynsrc/start.c +++ b/src/mzscheme/dynsrc/start.c @@ -22,7 +22,7 @@ # define GOEXE L"mred.exe" # define sGOEXE "mred.exe" # define GOEXE3M L"mred3m.exe" -# define WAITTILLDONE 0 +# define WAITTILDONE 0 #endif #ifdef MZSTART diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index e0d8fce257..ed5940c603 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -1,5 +1,5 @@ { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,54,252,225,7,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,54,252,225,7,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,65,35,37,115,116, 120,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99,159,36,16,16,30, 3,2,2,71,105,100,101,110,116,105,102,105,101,114,63,4,254,1,30,5,2, @@ -99,7 +99,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2029); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,134,252,215,18,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,134,252,215,18,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,71,35,37,113,113, 45,97,110,100,45,111,114,1,29,2,11,11,10,10,10,34,80,158,34,34,20, 99,159,34,16,1,30,3,2,2,69,113,113,45,97,112,112,101,110,100,4,254, @@ -118,7 +118,7 @@ 194,248,22,58,196,10,27,248,22,59,195,28,248,22,63,193,11,28,249,22,228, 195,248,22,58,195,10,27,248,22,59,194,28,248,22,63,193,11,28,249,22,228, 196,248,22,58,195,10,249,2,12,196,248,22,59,195,197,248,22,59,195,251,22, -252,46,2,11,6,20,20,100,117,112,108,105,99,97,116,101,32,105,100,101,110, +252,47,2,11,6,20,20,100,117,112,108,105,99,97,116,101,32,105,100,101,110, 116,105,102,105,101,114,14,199,196,251,80,159,39,52,35,198,199,248,22,59,201, 249,22,57,198,203,83,159,34,93,80,159,34,51,35,89,162,8,64,38,47,2, 11,223,0,28,248,22,63,197,12,27,28,195,248,22,83,198,248,80,158,36,34, @@ -127,7 +127,7 @@ 248,22,63,193,11,28,249,22,228,196,248,22,58,195,10,27,248,22,59,194,28, 248,22,63,193,11,28,249,22,228,197,248,22,58,195,10,27,248,22,59,194,28, 248,22,63,193,11,28,249,22,228,198,248,22,58,195,10,249,2,12,198,248,22, -59,195,251,22,252,46,2,11,6,20,20,100,117,112,108,105,99,97,116,101,32, +59,195,251,22,252,47,2,11,6,20,20,100,117,112,108,105,99,97,116,101,32, 105,100,101,110,116,105,102,105,101,114,15,201,197,87,94,250,22,121,198,248,22, 217,197,249,22,57,198,197,251,80,159,40,51,35,199,200,201,248,22,59,203,83, 159,34,93,80,159,34,50,35,89,162,8,100,38,50,64,108,111,111,112,16,223, @@ -136,9 +136,9 @@ 158,39,35,248,80,158,40,35,197,11,11,28,248,22,47,248,22,217,248,80,158, 40,34,197,28,196,249,22,57,248,80,158,40,34,197,248,80,158,40,34,248,80, 158,41,35,198,250,22,216,201,249,22,62,249,22,62,248,80,158,45,34,202,9, -248,80,158,43,35,200,197,251,22,252,46,2,11,6,30,30,98,97,100,32,115, +248,80,158,43,35,200,197,251,22,252,47,2,11,6,30,30,98,97,100,32,115, 121,110,116,97,120,32,40,110,111,116,32,97,110,32,105,100,101,110,116,105,102, -105,101,114,41,17,201,248,80,158,42,34,199,251,22,252,46,2,11,6,59,59, +105,101,114,41,17,201,248,80,158,42,34,199,251,22,252,47,2,11,6,59,59, 98,97,100,32,115,121,110,116,97,120,32,40,110,111,116,32,97,110,32,105,100, 101,110,116,105,102,105,101,114,32,97,110,100,32,101,120,112,114,101,115,115,105, 111,110,32,102,111,114,32,97,32,98,105,110,100,105,110,103,41,18,201,198,251, @@ -153,7 +153,7 @@ 38,197,27,248,80,158,39,35,198,28,248,80,158,39,37,193,10,28,248,80,158, 39,37,248,80,158,40,35,194,10,28,198,28,248,22,47,248,22,217,248,80,158, 41,34,195,248,80,158,39,37,248,80,158,40,35,248,80,158,41,35,195,11,11, -10,250,22,252,46,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,22, +10,250,22,252,47,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,22, 199,12,27,28,198,27,248,80,158,40,34,248,80,158,41,35,200,28,248,22,47, 248,22,217,194,192,11,11,27,248,80,158,40,39,27,28,195,248,80,158,42,35, 201,200,248,80,158,42,34,248,80,158,43,35,194,27,248,80,158,41,35,248,80, @@ -163,7 +163,7 @@ 250,22,216,201,28,198,250,22,1,22,66,250,22,66,20,15,159,50,36,40,248, 22,66,249,22,66,248,22,66,23,16,250,22,68,20,15,159,56,37,40,249,22, 1,22,66,249,22,2,22,58,23,19,23,16,204,249,22,2,22,59,200,250,22, -68,23,17,198,199,203,251,22,252,46,2,11,6,62,62,98,97,100,32,115,121, +68,23,17,198,199,203,251,22,252,47,2,11,6,62,62,98,97,100,32,115,121, 110,116,97,120,32,40,110,111,116,32,97,32,115,101,113,117,101,110,99,101,32, 111,102,32,105,100,101,110,116,105,102,105,101,114,45,45,101,120,112,114,101,115, 115,105,111,110,32,98,105,110,100,105,110,103,115,41,23,203,248,80,158,45,34, @@ -200,34 +200,34 @@ 34,93,80,159,34,57,35,89,162,34,39,53,62,113,113,63,223,0,28,248,80, 158,35,35,197,27,248,80,158,36,38,198,28,28,248,80,158,36,34,193,28,249, 22,230,194,197,248,80,158,36,39,198,11,11,27,248,80,158,37,36,199,87,94, -28,28,248,80,158,37,35,193,248,22,252,16,2,248,80,158,38,37,248,80,158, -39,36,195,10,251,22,252,46,2,67,117,110,113,117,111,116,101,64,6,30,30, +28,28,248,80,158,37,35,193,248,22,252,17,2,248,80,158,38,37,248,80,158, +39,36,195,10,251,22,252,47,2,67,117,110,113,117,111,116,101,64,6,30,30, 101,120,112,101,99,116,115,32,101,120,97,99,116,108,121,32,111,110,101,32,101, 120,112,114,101,115,115,105,111,110,65,199,202,12,28,248,22,193,200,248,80,158, 37,38,193,252,80,159,41,58,35,200,201,202,203,248,22,178,205,28,28,248,80, 158,36,34,193,28,249,22,230,194,20,15,159,37,43,40,248,80,158,36,39,198, 11,11,252,80,159,40,58,35,199,200,201,202,248,22,177,204,28,28,248,80,158, -36,34,193,28,249,22,230,194,198,248,80,158,36,39,198,11,11,251,22,252,46, +36,34,193,28,249,22,230,194,198,248,80,158,36,39,198,11,11,251,22,252,47, 2,76,117,110,113,117,111,116,101,45,115,112,108,105,99,105,110,103,66,6,33, 33,105,110,118,97,108,105,100,32,99,111,110,116,101,120,116,32,119,105,116,104, 105,110,32,113,117,97,115,105,113,117,111,116,101,67,198,201,28,28,248,80,158, 36,35,193,28,248,80,158,36,34,248,80,158,37,38,194,28,249,22,230,248,80, 158,38,38,195,198,248,80,158,36,39,193,11,11,11,27,248,80,158,37,36,194, -87,94,28,28,248,80,158,37,35,193,248,22,252,16,2,248,80,158,38,37,248, -80,158,39,36,195,10,251,22,252,46,2,2,64,6,30,30,101,120,112,101,99, +87,94,28,28,248,80,158,37,35,193,248,22,252,17,2,248,80,158,38,37,248, +80,158,39,36,195,10,251,22,252,47,2,2,64,6,30,30,101,120,112,101,99, 116,115,32,101,120,97,99,116,108,121,32,111,110,101,32,101,120,112,114,101,115, 115,105,111,110,68,199,202,12,27,248,80,158,38,38,194,27,248,80,158,39,36, 201,27,252,80,159,44,57,35,203,204,205,248,80,158,45,36,23,15,23,15,28, -248,22,193,203,27,28,249,22,252,18,2,195,196,28,248,80,158,41,37,194,20, +248,22,193,203,27,28,249,22,252,19,2,195,196,28,248,80,158,41,37,194,20, 15,159,40,37,40,249,22,65,20,15,159,42,38,40,195,193,250,22,65,20,15, 159,43,44,40,198,195,27,252,80,159,45,58,35,204,205,206,201,248,22,178,23, -17,28,28,249,22,252,18,2,195,196,249,22,252,18,2,194,198,11,202,27,27, -20,15,159,42,45,40,27,28,249,22,252,18,2,197,201,28,248,80,158,44,37, +17,28,28,249,22,252,19,2,195,196,249,22,252,19,2,194,198,11,202,27,27, +20,15,159,42,45,40,27,28,249,22,252,19,2,197,201,28,248,80,158,44,37, 196,20,15,159,43,37,40,249,22,65,20,15,159,45,38,40,197,195,28,248,80, 158,44,37,193,249,22,65,20,15,159,45,39,40,195,28,28,248,22,56,193,28, 249,22,230,20,15,159,45,40,40,248,22,58,195,10,249,22,230,20,15,159,45, 41,40,248,22,58,195,11,250,22,67,248,22,58,196,196,248,22,59,196,250,22, -65,20,15,159,46,42,40,196,195,27,28,249,22,252,18,2,197,198,28,248,80, +65,20,15,159,46,42,40,196,195,27,28,249,22,252,19,2,197,198,28,248,80, 158,43,37,196,20,15,159,42,37,40,249,22,65,20,15,159,44,38,40,197,195, 28,248,80,158,43,37,193,249,22,65,20,15,159,44,39,40,195,28,28,248,22, 56,193,28,249,22,230,20,15,159,44,40,40,248,22,58,195,10,249,22,230,20, @@ -235,16 +235,16 @@ 196,250,22,65,20,15,159,45,42,40,196,195,252,80,159,40,58,35,199,200,201, 202,203,28,28,248,22,213,197,248,22,252,229,1,248,22,217,198,11,27,248,22, 252,236,1,248,22,217,199,27,252,80,159,41,57,35,200,201,202,198,204,28,249, -22,252,18,2,195,194,198,249,22,65,20,15,159,38,46,40,194,28,248,22,213, +22,252,19,2,195,194,198,249,22,65,20,15,159,38,46,40,194,28,248,22,213, 197,28,248,22,113,248,22,217,198,27,248,22,114,248,22,217,199,27,252,80,159, -41,57,35,200,201,202,198,204,28,249,22,252,18,2,195,194,198,249,22,65,20, +41,57,35,200,201,202,198,204,28,249,22,252,19,2,195,194,198,249,22,65,20, 15,159,38,47,40,194,196,196,83,159,34,93,80,159,34,58,35,89,162,8,36, 39,50,67,113,113,45,108,105,115,116,69,223,0,27,248,80,158,36,38,198,27, 248,80,158,37,36,199,27,252,80,159,42,57,35,201,202,203,199,205,27,252,80, -159,43,57,35,202,203,204,199,206,28,28,249,22,252,18,2,195,197,249,22,252, -18,2,194,196,11,200,27,28,249,22,252,18,2,196,198,28,248,80,158,40,37, +159,43,57,35,202,203,204,199,206,28,28,249,22,252,19,2,195,197,249,22,252, +19,2,194,196,11,200,27,28,249,22,252,19,2,196,198,28,248,80,158,40,37, 195,20,15,159,39,37,40,249,22,65,20,15,159,41,38,40,196,194,27,28,249, -22,252,18,2,196,198,28,248,80,158,41,37,195,20,15,159,40,37,40,249,22, +22,252,19,2,196,198,28,248,80,158,41,37,195,20,15,159,40,37,40,249,22, 65,20,15,159,42,38,40,196,194,28,248,80,158,41,37,193,249,22,65,20,15, 159,42,39,40,195,28,28,248,22,56,193,28,249,22,230,20,15,159,42,40,40, 248,22,58,195,10,249,22,230,20,15,159,42,41,40,248,22,58,195,11,250,22, @@ -255,16 +255,16 @@ 22,58,197,10,249,22,230,20,15,159,36,41,40,248,22,58,197,11,250,22,67, 248,22,58,198,196,248,22,59,198,250,22,65,20,15,159,37,42,40,196,197,83, 159,34,93,80,159,34,55,35,89,162,8,36,36,39,66,110,111,114,109,97,108, -71,223,0,28,249,22,252,18,2,195,196,28,248,80,158,35,37,194,20,15,159, +71,223,0,28,249,22,252,19,2,195,196,28,248,80,158,35,37,194,20,15,159, 34,37,40,249,22,65,20,15,159,36,38,40,195,193,27,20,15,159,35,34,40, 27,20,15,159,36,35,40,27,20,15,159,37,36,40,89,162,8,36,35,50,9, -226,3,0,1,2,87,94,28,248,80,158,38,34,197,250,22,252,46,2,11,6, +226,3,0,1,2,87,94,28,248,80,158,38,34,197,250,22,252,47,2,11,6, 10,10,98,97,100,32,115,121,110,116,97,120,72,199,12,27,28,248,80,158,39, 35,248,80,158,40,36,199,28,248,80,158,39,37,248,80,158,40,36,248,80,158, -41,36,200,248,80,158,39,38,248,80,158,40,36,199,250,22,252,46,2,11,6, -10,10,98,97,100,32,115,121,110,116,97,120,73,200,250,22,252,46,2,11,6, +41,36,200,248,80,158,39,38,248,80,158,40,36,199,250,22,252,47,2,11,6, +10,10,98,97,100,32,115,121,110,116,97,120,73,200,250,22,252,47,2,11,6, 10,10,98,97,100,32,115,121,110,116,97,120,74,200,250,22,216,196,27,252,80, -159,47,57,35,206,203,204,201,34,28,249,22,252,18,2,194,198,28,248,80,158, +159,47,57,35,206,203,204,201,34,28,249,22,252,19,2,194,198,28,248,80,158, 43,37,193,20,15,159,42,37,40,249,22,65,20,15,159,44,38,40,194,192,200, 37,20,99,159,38,16,6,30,75,2,25,71,105,100,101,110,116,105,102,105,101, 114,63,76,2,2,29,2,27,2,31,2,24,2,33,16,14,18,97,64,104,101, @@ -299,7 +299,7 @@ 4,8,49,11,61,118,113,3,1,7,101,110,118,50,53,53,52,114,16,4,8, 48,11,62,113,118,115,3,1,7,101,110,118,50,53,53,53,116,11,16,5,93, 2,5,27,20,15,159,35,34,39,89,162,34,35,48,9,224,1,0,87,94,28, -248,80,158,36,34,195,12,250,22,252,46,2,11,6,10,10,98,97,100,32,115, +248,80,158,36,34,195,12,250,22,252,47,2,11,6,10,10,98,97,100,32,115, 121,110,116,97,120,117,197,27,248,80,158,37,35,196,28,248,80,158,37,36,193, 20,15,159,36,35,39,28,28,248,80,158,37,37,193,248,80,158,37,36,248,80, 158,38,35,194,10,248,80,158,37,38,193,250,22,216,196,251,22,65,20,15,159, @@ -311,14 +311,14 @@ 8,52,11,61,101,120,3,1,7,101,110,118,50,53,53,57,121,18,16,2,158, 62,105,102,122,8,55,8,56,18,16,2,158,2,5,8,55,8,57,18,158,11, 8,55,11,16,5,93,2,6,27,20,15,159,35,34,40,89,162,34,35,51,9, -224,1,0,87,94,28,248,80,158,36,34,195,250,22,252,46,2,11,6,10,10, +224,1,0,87,94,28,248,80,158,36,34,195,250,22,252,47,2,11,6,10,10, 98,97,100,32,115,121,110,116,97,120,123,197,12,27,248,80,158,37,35,196,28, 248,80,158,37,36,193,20,15,159,36,35,40,28,28,248,80,158,37,37,193,248, 80,158,37,36,248,80,158,38,35,194,11,248,80,158,37,38,193,28,248,80,158, 37,39,193,250,22,216,196,250,22,65,20,15,159,42,36,40,248,22,65,249,22, 65,67,111,114,45,112,97,114,116,124,248,80,158,46,38,202,251,22,65,20,15, 159,46,37,40,2,124,2,124,249,22,57,20,15,159,48,38,40,248,80,158,49, -35,205,198,250,22,252,46,2,11,6,10,10,98,97,100,32,115,121,110,116,97, +35,205,198,250,22,252,47,2,11,6,10,10,98,97,100,32,115,121,110,116,97, 120,125,198,35,20,99,159,34,16,6,2,75,2,27,2,31,2,29,2,24,2, 33,16,5,18,8,51,18,100,11,8,61,37,36,35,16,4,8,60,11,2,77, 3,1,7,101,110,118,50,53,54,49,126,16,4,8,59,11,2,83,3,1,7, @@ -327,13 +327,13 @@ 4,8,62,11,63,116,109,112,129,3,1,7,101,110,118,50,53,54,52,130,18, 16,2,158,2,122,8,63,8,64,18,16,2,158,2,6,8,63,8,65,11,93, 83,159,34,93,80,159,34,34,35,32,131,89,162,34,36,39,2,4,222,28,248, -22,64,193,249,22,71,194,195,250,22,252,47,2,2,66,6,11,11,112,114,111, +22,64,193,249,22,71,194,195,250,22,252,48,2,2,66,6,11,11,112,114,111, 112,101,114,32,108,105,115,116,132,195,93,68,35,37,107,101,114,110,101,108,133, 94,2,25,2,133,0}; EVAL_ONE_SIZED_STR((char *)expr, 4835); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,49,252,234,4,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,49,252,234,4,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,66,35,37,99,111, 110,100,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99,159,34,16,0, 16,0,11,11,16,0,34,11,16,1,64,99,111,110,100,3,16,1,11,16,1, @@ -342,7 +342,7 @@ 20,15,159,34,35,39,28,248,80,158,35,37,195,27,248,80,158,36,38,196,27, 248,80,158,37,35,197,28,248,80,158,37,37,194,27,248,80,158,38,38,195,27, 248,80,158,39,35,196,27,28,248,80,158,40,34,195,249,22,230,196,20,15,159, -41,36,39,11,87,94,28,192,28,248,80,158,40,37,196,251,22,252,46,2,11, +41,36,39,11,87,94,28,192,28,248,80,158,40,37,196,251,22,252,47,2,11, 6,39,39,98,97,100,32,115,121,110,116,97,120,32,40,96,101,108,115,101,39, 32,99,108,97,117,115,101,32,109,117,115,116,32,98,101,32,108,97,115,116,41, 5,202,200,12,12,28,28,248,80,158,40,37,194,28,248,80,158,40,34,248,80, @@ -351,7 +351,7 @@ 41,35,248,80,158,42,35,196,11,27,28,193,10,195,27,247,22,54,250,22,65, 20,15,159,44,38,39,248,22,65,249,22,65,248,22,65,199,199,251,22,65,20, 15,159,48,39,39,199,249,22,65,248,80,158,51,38,248,80,158,52,35,206,201, -250,80,159,51,53,35,23,18,23,15,11,251,22,252,46,2,11,6,36,36,98, +250,80,159,51,53,35,23,18,23,15,11,251,22,252,47,2,11,6,36,36,98, 97,100,32,115,121,110,116,97,120,32,40,98,97,100,32,99,108,97,117,115,101, 32,102,111,114,109,32,119,105,116,104,32,61,62,41,6,202,200,28,192,28,200, 250,22,65,20,15,159,42,40,39,10,249,22,57,20,15,159,44,41,39,198,249, @@ -359,14 +359,14 @@ 22,65,20,15,159,43,43,39,248,22,65,249,22,65,248,22,65,199,201,251,22, 65,20,15,159,47,44,39,199,199,250,80,159,50,53,35,23,17,206,11,251,22, 65,20,15,159,43,45,39,198,249,22,57,20,15,159,45,46,39,199,250,80,159, -46,53,35,205,202,11,251,22,252,46,2,11,6,44,44,98,97,100,32,115,121, +46,53,35,205,202,11,251,22,252,47,2,11,6,44,44,98,97,100,32,115,121, 110,116,97,120,32,40,99,108,97,117,115,101,32,105,115,32,110,111,116,32,97, 32,116,101,115,116,45,118,97,108,117,101,32,112,97,105,114,41,7,199,197,251, -22,252,46,2,11,6,46,46,98,97,100,32,115,121,110,116,97,120,32,40,98, +22,252,47,2,11,6,46,46,98,97,100,32,115,121,110,116,97,120,32,40,98, 111,100,121,32,109,117,115,116,32,99,111,110,116,97,105,110,32,97,32,108,105, 115,116,32,111,102,32,112,97,105,114,115,41,8,197,198,27,20,15,159,35,34, 39,89,162,8,36,35,45,9,224,1,0,87,94,28,248,80,158,36,34,195,250, -22,252,46,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,9,197,12, +22,252,47,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,9,197,12, 250,22,216,195,27,248,80,158,40,35,199,250,80,159,42,53,35,201,195,10,197, 35,20,99,159,35,16,5,30,10,65,35,37,115,116,120,11,71,105,100,101,110, 116,105,102,105,101,114,63,12,2,30,13,2,11,67,115,116,120,45,99,100,114, @@ -397,7 +397,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 1270); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,25,252,68,4,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,25,252,68,4,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,73,35,37,115,116, 114,117,99,116,45,105,110,102,111,1,29,2,11,11,10,10,10,34,80,158,34, 34,20,99,159,34,16,9,30,3,2,2,74,105,100,101,110,116,105,102,105,101, @@ -415,36 +415,36 @@ 0,11,11,16,2,2,9,2,4,36,11,16,6,2,19,2,15,2,21,2,17, 2,13,2,11,16,6,11,11,11,11,11,11,16,6,2,19,2,15,2,21,2, 17,2,13,2,11,40,40,9,100,83,159,34,93,80,159,34,34,35,89,162,34, -35,38,2,4,223,0,27,248,22,252,16,2,195,28,192,192,248,80,158,36,35, +35,38,2,4,223,0,27,248,22,252,17,2,195,28,192,192,248,80,158,36,35, 195,83,159,34,93,80,159,34,36,35,89,162,34,36,42,2,9,223,0,28,248, 22,63,195,10,28,248,22,56,195,28,248,22,63,248,22,59,196,27,248,22,58, -196,27,248,22,252,16,2,194,28,192,192,248,80,158,37,35,194,28,248,194,248, +196,27,248,22,252,17,2,194,28,192,192,248,80,158,37,35,194,28,248,194,248, 22,58,196,27,248,22,59,196,28,248,22,63,193,10,28,248,22,56,193,28,248, -22,63,248,22,59,194,27,248,22,58,194,27,248,22,252,16,2,194,28,192,192, +22,63,248,22,59,194,27,248,22,58,194,27,248,22,252,17,2,194,28,192,192, 248,80,158,38,35,194,28,248,195,248,22,58,194,27,248,22,59,194,28,248,22, 63,193,10,28,248,22,56,193,28,248,22,63,248,22,59,194,27,248,22,58,194, -27,248,22,252,16,2,194,28,192,192,248,80,158,39,35,194,28,248,196,248,22, +27,248,22,252,17,2,194,28,192,192,248,80,158,39,35,194,28,248,196,248,22, 58,194,249,80,159,38,36,35,197,248,22,59,195,11,11,11,11,11,11,83,159, 34,93,80,159,34,37,35,89,162,34,35,42,2,11,223,0,28,248,22,64,194, -28,249,22,188,248,22,70,196,40,28,27,248,22,58,195,27,248,22,252,16,2, -194,28,192,192,248,80,158,37,35,194,28,27,248,22,84,195,27,248,22,252,16, +28,249,22,188,248,22,70,196,40,28,27,248,22,58,195,27,248,22,252,17,2, +194,28,192,192,248,80,158,37,35,194,28,27,248,22,84,195,27,248,22,252,17, 2,194,28,192,192,248,80,158,37,35,194,28,27,248,22,93,195,27,248,22,252, -16,2,194,28,192,192,248,80,158,37,35,194,28,27,80,158,35,35,27,249,22, +17,2,194,28,192,192,248,80,158,37,35,194,28,27,80,158,35,35,27,249,22, 76,197,37,28,248,22,63,193,10,28,248,22,56,193,28,248,22,63,248,22,59, -194,27,248,22,58,194,27,248,22,252,16,2,194,28,192,192,248,80,158,39,35, +194,27,248,22,58,194,27,248,22,252,17,2,194,28,192,192,248,80,158,39,35, 194,28,248,194,248,22,58,194,27,248,22,59,194,28,248,22,63,193,10,28,248, -22,56,193,28,248,22,63,248,22,59,194,27,248,22,58,194,27,248,22,252,16, +22,56,193,28,248,22,63,248,22,59,194,27,248,22,58,194,27,248,22,252,17, 2,194,28,192,192,248,80,158,40,35,194,28,248,195,248,22,58,194,249,80,159, 39,36,35,196,248,22,59,195,11,11,11,11,28,27,249,22,76,196,38,28,248, 22,63,193,10,28,248,22,56,193,28,248,22,63,248,22,59,194,27,248,22,58, -194,27,248,22,252,16,2,194,28,192,192,248,80,158,38,35,194,28,27,248,22, -58,194,27,248,22,252,16,2,194,28,192,192,248,80,158,38,35,194,27,248,22, +194,27,248,22,252,17,2,194,28,192,192,248,80,158,38,35,194,28,27,248,22, +58,194,27,248,22,252,17,2,194,28,192,192,248,80,158,38,35,194,27,248,22, 59,194,28,248,22,63,193,10,28,248,22,56,193,28,248,22,63,248,22,59,194, -27,248,22,58,194,27,248,22,252,16,2,194,28,192,192,248,80,158,39,35,194, -28,27,248,22,58,194,27,248,22,252,16,2,194,28,192,192,248,80,158,39,35, +27,248,22,58,194,27,248,22,252,17,2,194,28,192,192,248,80,158,39,35,194, +28,27,248,22,58,194,27,248,22,252,17,2,194,28,192,192,248,80,158,39,35, 194,249,80,159,38,36,35,80,159,38,34,35,248,22,59,195,11,11,11,11,27, -27,249,22,76,197,39,27,248,22,252,16,2,194,28,192,192,248,80,158,38,35, -194,28,192,192,249,22,252,18,2,10,249,22,76,198,39,11,11,11,11,11,11, +27,249,22,76,197,39,27,248,22,252,17,2,194,28,192,192,248,80,158,38,35, +194,28,192,192,249,22,252,19,2,10,249,22,76,198,39,11,11,11,11,11,11, 11,83,159,34,93,80,159,34,38,35,22,58,83,159,34,93,80,159,34,39,35, 22,84,83,159,34,93,80,159,34,40,35,22,93,83,159,34,93,80,159,34,41, 35,22,96,83,159,34,93,80,159,34,42,35,32,22,89,162,34,35,37,2,21, @@ -453,7 +453,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 1104); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,37,252,208,4,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,37,252,208,4,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,71,35,37,100,115, 45,104,101,108,112,101,114,1,29,2,11,11,10,10,10,34,80,158,34,34,20, 99,159,34,16,6,30,3,2,2,1,20,108,105,115,116,45,62,105,109,109,117, @@ -472,9 +472,9 @@ 35,248,22,59,196,83,159,34,93,80,159,34,35,35,89,162,34,38,8,32,2, 6,223,0,27,28,197,247,22,54,11,27,28,198,89,162,8,36,35,40,62,113, 115,16,223,1,28,193,249,22,65,194,249,22,65,72,113,117,111,116,101,45,115, -121,110,116,97,120,17,197,11,22,7,27,28,197,249,22,252,100,3,199,32,18, +121,110,116,97,120,17,197,11,22,7,27,28,197,249,22,252,101,3,199,32,18, 89,162,8,44,34,34,9,222,11,11,87,94,28,197,28,28,248,80,158,38,36, -193,248,22,252,16,2,248,80,158,39,37,194,10,251,22,252,46,2,11,28,248, +193,248,22,252,17,2,248,80,158,39,37,194,10,251,22,252,47,2,11,28,248, 80,158,42,36,197,6,63,63,112,97,114,101,110,116,32,115,116,114,117,99,116, 32,105,110,102,111,114,109,97,116,105,111,110,32,100,111,101,115,32,110,111,116, 32,105,110,99,108,117,100,101,32,97,32,116,121,112,101,32,102,111,114,32,115, @@ -516,7 +516,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 1244); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,123,252,43,12,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,123,252,43,12,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,74,35,37,100,101, 102,105,110,101,45,101,116,45,97,108,1,29,2,11,11,10,10,10,34,80,158, 34,34,20,99,159,34,16,0,16,0,11,11,16,0,34,11,16,6,73,100,101, @@ -555,7 +555,7 @@ 6,89,162,34,35,47,9,223,0,27,248,22,223,195,28,28,192,249,22,190,248, 22,70,195,36,11,250,22,216,20,15,159,38,34,36,250,22,65,20,15,159,41, 35,36,248,80,158,42,34,248,80,158,43,35,202,249,22,67,20,15,159,43,36, -36,248,80,158,44,35,248,80,158,45,35,204,197,250,22,252,46,2,11,6,10, +36,248,80,158,44,35,248,80,158,45,35,204,197,250,22,252,47,2,11,6,10, 10,98,97,100,32,115,121,110,116,97,120,41,197,34,20,99,159,34,16,2,2, 14,2,11,16,3,18,99,2,23,52,37,36,35,16,4,51,11,61,120,42,3, 1,7,101,110,118,50,54,49,54,43,16,4,50,11,61,108,44,3,1,7,101, @@ -563,7 +563,7 @@ 2,0,52,54,11,16,5,93,2,5,89,162,34,35,47,9,223,0,27,248,22, 223,195,28,28,192,249,22,190,248,22,70,195,36,11,250,22,216,20,15,159,38, 34,34,251,22,65,20,15,159,42,35,34,248,22,84,200,20,15,159,42,36,34, -249,22,67,20,15,159,44,37,34,248,22,86,202,197,250,22,252,46,2,11,6, +249,22,67,20,15,159,44,37,34,248,22,86,202,197,250,22,252,47,2,11,6, 10,10,98,97,100,32,115,121,110,116,97,120,47,197,34,20,99,159,34,16,0, 16,4,18,99,2,23,57,37,36,35,16,4,56,11,2,42,3,1,7,101,110, 118,50,54,49,57,48,16,4,55,11,2,44,3,1,7,101,110,118,50,54,50, @@ -573,7 +573,7 @@ 36,34,248,22,84,194,11,11,27,248,22,84,194,27,248,80,158,38,35,248,80, 158,39,35,198,250,22,216,20,15,159,40,34,38,249,22,65,67,99,97,108,108, 47,101,99,51,250,22,67,2,10,248,22,65,202,249,80,158,47,36,248,80,158, -48,37,203,9,199,250,22,252,46,2,11,6,10,10,98,97,100,32,115,121,110, +48,37,203,9,199,250,22,252,47,2,11,6,10,10,98,97,100,32,115,121,110, 116,97,120,52,197,34,20,99,159,34,16,4,2,16,2,11,2,18,2,21,16, 1,18,100,2,23,8,29,37,36,35,16,4,8,28,11,2,30,3,1,7,101, 110,118,50,54,50,50,53,16,4,8,27,11,2,44,3,1,7,101,110,118,50, @@ -598,10 +598,10 @@ 22,65,2,66,248,22,58,203,251,22,65,2,70,2,64,199,249,22,65,2,66, 248,22,58,203,249,2,71,248,22,59,199,248,22,177,198,248,22,59,23,20,35, 9,89,162,8,36,35,8,29,9,224,1,0,87,94,28,248,80,158,36,35,195, -250,22,252,46,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,73,197, +250,22,252,47,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,73,197, 12,27,248,80,158,37,36,248,80,158,38,37,197,87,100,27,248,22,56,194,28, 192,192,249,32,74,89,162,35,37,42,72,115,121,110,116,97,120,45,101,114,114, -111,114,75,222,252,22,1,22,252,46,2,11,198,197,199,198,6,17,17,101,109, +111,114,75,222,252,22,1,22,252,47,2,11,198,197,199,198,6,17,17,101,109, 112,116,121,32,100,101,99,108,97,114,97,116,105,111,110,76,27,248,80,158,38, 38,194,28,192,192,249,2,74,198,6,18,18,105,108,108,101,103,97,108,32,117, 115,101,32,111,102,32,96,46,39,77,27,250,22,191,36,248,22,70,197,37,28, @@ -623,7 +623,7 @@ 5,27,248,80,158,37,35,196,28,192,192,250,2,74,196,6,27,27,102,105,101, 108,100,32,110,97,109,101,32,110,111,116,32,97,32,105,100,101,110,116,105,102, 105,101,114,82,198,248,80,158,39,36,248,22,84,196,28,249,22,77,247,22,252, -102,3,21,93,70,101,120,112,114,101,115,115,105,111,110,83,249,2,74,197,6, +103,3,21,93,70,101,120,112,114,101,115,115,105,111,110,83,249,2,74,197,6, 35,35,97,108,108,111,119,101,100,32,111,110,108,121,32,105,110,32,100,101,102, 105,110,105,116,105,111,110,32,99,111,110,116,101,120,116,115,84,12,27,28,248, 80,158,38,35,248,22,58,195,248,22,58,194,248,80,158,38,40,248,22,58,195, @@ -646,7 +646,7 @@ 114,111,114,95,94,2,66,2,3,6,15,15,105,110,115,112,101,99,116,111,114, 32,111,114,32,35,102,96,2,92,196,192,250,22,65,2,40,248,22,65,23,17, 203,206,28,196,250,22,225,195,75,100,105,115,97,112,112,101,97,114,101,100,45, -117,115,101,97,248,22,252,105,3,200,192,35,20,99,159,34,16,9,2,18,2, +117,115,101,97,248,22,252,106,3,200,192,35,20,99,159,34,16,9,2,18,2, 16,2,21,2,11,30,98,2,12,69,115,116,120,45,108,105,115,116,63,99,8, 30,100,2,12,69,115,116,120,45,112,97,105,114,63,101,11,2,14,30,102,2, 12,69,115,116,120,45,110,117,108,108,63,103,10,30,104,2,24,72,103,101,116, @@ -668,7 +668,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 3127); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,21,252,37,1,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,21,252,37,1,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,74,35,37,115,109, 97,108,108,45,115,99,104,101,109,101,1,29,2,11,11,10,10,10,34,80,158, 34,34,20,99,159,34,16,0,16,0,11,11,16,0,34,11,16,13,66,108,101, @@ -686,7 +686,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 305); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,231,252,136,53,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,231,252,136,53,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,115,64,35,37,115,99, 1,29,2,11,11,10,10,18,95,11,37,96,35,8,254,1,11,16,2,64,115, 101,116,33,3,68,35,37,107,101,114,110,101,108,4,42,80,158,34,34,20,99, @@ -737,14 +737,14 @@ 103,45,100,101,112,116,104,90,254,1,30,91,2,2,1,21,115,121,110,116,97, 120,45,109,97,112,112,105,110,103,45,118,97,108,118,97,114,92,254,1,16,3, 18,98,63,46,46,46,93,41,98,40,10,34,11,94,159,74,35,37,115,109,97, -108,108,45,115,99,104,101,109,101,94,9,11,159,2,20,9,11,16,72,2,56, -2,2,2,46,2,2,2,16,2,2,2,48,2,2,2,66,2,2,2,78,2, -2,2,10,2,2,2,50,2,2,2,27,2,2,2,84,2,2,2,80,2,2, -2,62,2,2,2,60,2,2,2,90,2,2,2,6,2,2,2,12,2,2,2, -64,2,2,2,35,2,2,2,68,2,2,2,54,2,2,2,86,2,2,2,18, -2,2,2,31,2,2,2,58,2,2,2,92,2,2,2,29,2,2,2,72,2, -2,2,76,2,2,2,70,2,2,2,74,2,2,2,8,2,2,2,52,2,2, -2,14,2,2,2,37,2,2,2,88,2,2,2,82,2,2,96,39,35,11,16, +108,108,45,115,99,104,101,109,101,94,9,11,159,2,20,9,11,16,72,2,46, +2,2,2,62,2,2,2,48,2,2,2,84,2,2,2,10,2,2,2,50,2, +2,2,27,2,2,2,86,2,2,2,60,2,2,2,90,2,2,2,78,2,2, +2,6,2,2,2,12,2,2,2,64,2,2,2,80,2,2,2,16,2,2,2, +92,2,2,2,68,2,2,2,54,2,2,2,72,2,2,2,18,2,2,2,56, +2,2,2,58,2,2,2,29,2,2,2,31,2,2,2,70,2,2,2,74,2, +2,2,8,2,2,2,52,2,2,2,35,2,2,2,14,2,2,2,37,2,2, +2,76,2,2,2,66,2,2,2,88,2,2,2,82,2,2,96,39,35,11,16, 0,35,16,4,38,11,61,115,95,3,1,7,101,110,118,50,54,53,51,96,18, 103,2,93,48,40,39,35,16,10,47,11,61,112,97,67,112,114,111,116,111,45, 114,98,61,107,99,64,100,101,115,116,100,3,1,7,101,110,118,50,55,51,51, @@ -769,7 +769,7 @@ 162,8,64,37,47,63,115,117,98,121,223,0,28,28,195,28,248,80,158,35,47, 195,27,248,80,158,36,42,196,28,248,80,158,36,47,193,28,27,248,80,158,37, 43,194,28,248,22,47,248,22,217,194,249,22,230,194,20,15,159,38,34,8,43, -11,248,22,252,16,2,27,248,80,158,38,43,198,28,248,22,47,248,22,217,194, +11,248,22,252,17,2,27,248,80,158,38,43,198,28,248,22,47,248,22,217,194, 249,22,230,194,20,15,159,39,34,8,43,11,11,11,11,11,91,159,36,11,90, 161,36,34,11,27,248,80,158,38,42,248,80,158,39,42,199,28,28,248,80,158, 38,47,193,27,248,80,158,39,43,194,28,248,22,47,248,22,217,194,249,22,230, @@ -821,7 +821,7 @@ 93,80,159,34,8,47,35,89,162,34,43,8,45,63,109,38,101,124,223,0,28, 28,199,28,248,80,158,35,47,198,27,248,80,158,36,42,199,28,248,80,158,36, 47,193,28,27,248,80,158,37,43,194,28,248,22,47,248,22,217,194,249,22,230, -194,20,15,159,38,34,8,43,11,248,22,252,16,2,27,248,80,158,38,43,201, +194,20,15,159,38,34,8,43,11,248,22,252,17,2,27,248,80,158,38,43,201, 28,248,22,47,248,22,217,194,249,22,230,194,20,15,159,39,34,8,43,11,11, 11,11,11,28,248,80,158,35,41,248,80,158,36,42,248,80,158,37,42,200,27, 248,80,158,36,43,199,27,249,80,159,38,44,35,195,199,91,159,37,11,90,161, @@ -830,7 +830,7 @@ 45,35,198,32,125,89,162,8,44,35,35,9,222,10,250,22,7,250,22,65,66, 108,97,109,98,100,97,126,21,93,61,101,127,251,22,67,62,105,102,128,21,94, 69,115,116,120,45,108,105,115,116,63,129,2,127,27,248,80,159,52,46,35,205, -28,249,22,252,20,2,194,21,94,64,108,105,115,116,130,2,127,28,23,25,21, +28,249,22,252,21,2,194,21,94,64,108,105,115,116,130,2,127,28,23,25,21, 94,69,115,116,120,45,62,108,105,115,116,131,2,127,21,94,2,130,94,2,131, 2,127,28,248,22,63,204,250,22,67,66,97,110,100,109,97,112,132,250,22,65, 2,126,21,93,2,127,198,21,93,94,2,131,2,127,250,22,65,66,108,101,116, @@ -846,7 +846,7 @@ 80,158,37,42,248,80,158,38,42,201,91,159,36,11,90,161,36,34,11,28,248, 80,158,39,41,195,249,22,7,34,10,28,248,80,158,39,47,195,87,94,28,27, 248,80,158,40,43,196,28,248,22,47,248,22,217,194,249,22,230,194,20,15,159, -41,34,8,43,11,251,22,252,46,2,248,22,217,202,6,54,54,109,105,115,112, +41,34,8,43,11,251,22,252,47,2,248,22,217,202,6,54,54,109,105,115,112, 108,97,99,101,100,32,101,108,108,105,112,115,101,115,32,105,110,32,112,97,116, 116,101,114,110,32,40,102,111,108,108,111,119,115,32,111,116,104,101,114,32,101, 108,108,105,112,115,101,115,41,144,202,248,80,158,43,43,199,12,251,80,159,42, @@ -856,14 +856,14 @@ 11,26,9,80,159,56,8,47,35,23,23,23,24,23,25,23,26,23,20,23,28, 23,29,23,30,10,90,161,37,40,11,28,23,17,250,22,7,195,196,11,26,9, 80,159,56,8,47,35,23,23,23,24,23,25,23,26,23,21,23,21,23,29,28, -23,30,248,22,252,16,2,206,11,11,28,23,17,250,22,7,249,22,71,203,200, +23,30,248,22,252,17,2,206,11,11,28,23,17,250,22,7,249,22,71,203,200, 11,11,250,22,7,250,22,65,2,126,21,93,2,127,250,22,65,71,108,101,116, 42,45,118,97,108,117,101,115,145,248,22,65,249,22,65,21,95,69,112,114,101, 45,105,116,101,109,115,146,70,112,111,115,116,45,105,116,101,109,115,147,63,111, 107,63,148,251,22,65,74,115,112,108,105,116,45,115,116,120,45,108,105,115,116, 149,2,127,23,25,23,26,251,22,67,2,128,2,148,27,27,249,80,159,8,30, 48,35,23,23,2,146,27,249,80,159,8,31,48,35,23,21,2,147,28,23,23, -28,28,248,22,56,194,28,249,22,252,18,2,248,22,58,196,2,130,28,248,22, +28,28,248,22,56,194,28,249,22,252,19,2,248,22,58,196,2,130,28,248,22, 56,248,22,59,195,248,22,63,248,22,86,195,11,11,11,250,22,65,67,99,111, 110,115,47,35,102,150,248,22,84,197,195,250,22,65,69,97,112,112,101,110,100, 47,35,102,151,196,195,251,22,67,2,128,197,196,21,93,11,28,23,19,28,23, @@ -874,7 +874,7 @@ 194,249,22,230,194,20,15,159,37,34,8,43,11,11,28,28,248,80,158,36,47, 248,80,158,37,42,200,248,80,158,36,41,248,80,158,37,42,248,80,158,38,42, 201,11,27,248,80,158,37,43,248,80,158,38,42,201,26,9,80,159,45,8,47, -35,204,205,206,23,15,201,201,11,23,19,11,251,22,252,46,2,248,22,217,199, +35,204,205,206,23,15,201,201,11,23,19,11,251,22,252,47,2,248,22,217,199, 6,29,29,109,105,115,112,108,97,99,101,100,32,101,108,108,105,112,115,101,115, 32,105,110,32,112,97,116,116,101,114,110,154,199,196,91,159,43,11,90,161,37, 34,11,28,206,26,9,80,159,53,8,47,35,23,20,23,21,23,22,23,23,23, @@ -882,11 +882,11 @@ 159,53,8,47,35,23,20,23,21,23,22,23,23,248,80,158,54,42,23,25,23, 25,23,26,23,27,10,90,161,37,40,11,28,206,250,22,7,195,196,11,26,9, 80,159,53,8,47,35,23,20,23,21,23,22,23,23,23,18,23,18,23,26,28, -23,27,248,22,252,16,2,206,11,11,28,206,250,22,7,249,22,71,203,200,11, +23,27,248,22,252,17,2,206,11,11,28,206,250,22,7,249,22,71,203,200,11, 11,250,22,7,250,22,65,2,126,21,93,2,127,251,22,67,2,128,21,94,2, 33,2,127,27,27,249,80,159,58,48,35,23,20,21,94,2,25,2,127,27,249, 80,159,59,48,35,23,18,21,94,2,23,2,127,28,23,20,28,28,248,22,56, -194,28,249,22,252,18,2,248,22,58,196,2,130,28,248,22,56,248,22,59,195, +194,28,249,22,252,19,2,248,22,58,196,2,130,28,248,22,56,248,22,59,195, 248,22,63,248,22,86,195,11,11,11,250,22,65,2,150,248,22,84,197,195,250, 22,65,2,151,196,195,251,22,67,2,128,197,196,21,93,11,28,23,16,28,23, 30,250,22,65,2,135,21,93,94,2,152,96,2,128,94,2,153,2,127,2,127, @@ -900,7 +900,7 @@ 102,105,101,114,61,63,156,2,127,249,22,65,72,113,117,111,116,101,45,115,121, 110,116,97,120,157,23,23,21,94,64,110,117,108,108,158,11,21,93,11,11,11, 28,28,199,28,248,22,47,248,22,217,199,249,22,230,199,20,15,159,36,34,8, -43,11,11,251,22,252,46,2,248,22,217,198,6,29,29,109,105,115,112,108,97, +43,11,11,251,22,252,47,2,248,22,217,198,6,29,29,109,105,115,112,108,97, 99,101,100,32,101,108,108,105,112,115,101,115,32,105,110,32,112,97,116,116,101, 114,110,159,198,201,28,196,250,22,7,248,22,65,201,11,11,250,22,7,27,28, 204,32,160,89,162,8,36,35,38,64,119,114,97,112,161,222,250,22,65,2,126, @@ -908,10 +908,10 @@ 21,93,2,127,249,22,65,2,130,197,28,205,248,193,21,96,1,20,100,97,116, 117,109,45,62,115,121,110,116,97,120,45,111,98,106,101,99,116,163,2,152,2, 127,2,152,248,193,2,127,10,204,28,249,80,158,36,51,199,11,27,248,22,252, -236,1,248,22,217,200,28,28,197,11,27,248,22,252,16,2,202,28,192,192,249, +236,1,248,22,217,200,28,28,197,11,27,248,22,252,17,2,202,28,192,192,249, 22,4,80,159,38,8,49,35,195,27,248,22,252,233,1,248,22,217,201,26,10, 80,159,46,8,50,35,202,23,17,23,19,205,206,23,15,23,16,202,248,22,252, -16,2,23,21,9,91,159,37,11,90,161,37,34,11,26,9,80,159,47,8,47, +17,2,23,21,9,91,159,37,11,90,161,37,34,11,26,9,80,159,47,8,47, 35,206,23,15,23,16,23,17,204,23,18,23,20,23,21,11,28,200,250,22,7, 195,11,11,250,22,7,250,22,65,2,126,21,93,2,127,251,22,67,2,128,21, 95,2,41,2,127,11,249,80,159,50,48,35,204,21,94,72,118,101,99,116,111, @@ -924,24 +924,24 @@ 201,250,22,7,250,22,65,2,126,21,93,2,127,251,22,67,2,128,250,22,65, 2,41,2,127,206,23,20,21,93,11,204,11,91,159,37,11,90,161,37,34,11, 27,249,22,252,234,1,248,22,217,201,248,22,178,23,15,26,9,80,159,47,8, -47,35,23,17,23,18,23,19,23,20,201,201,23,16,248,22,252,16,2,23,23, +47,35,23,17,23,18,23,19,23,20,201,201,23,16,248,22,252,17,2,23,23, 11,26,10,80,159,47,8,50,35,206,23,15,23,16,23,17,23,18,23,19,23, 20,248,22,178,23,22,28,23,22,23,22,203,27,249,80,159,50,48,35,205,250, 22,65,74,115,116,120,45,118,101,99,116,111,114,45,114,101,102,168,2,127,248, 22,178,23,28,28,248,22,63,23,25,192,28,204,28,28,248,22,56,193,28,249, -22,252,18,2,248,22,58,195,2,130,28,248,22,56,248,22,59,194,248,22,63, +22,252,19,2,248,22,58,195,2,130,28,248,22,56,248,22,59,194,248,22,63, 248,22,86,194,11,11,11,250,22,65,2,150,248,22,84,196,23,27,250,22,65, 2,151,195,23,27,251,22,67,2,128,196,23,28,21,93,11,83,159,34,93,80, -159,34,8,49,35,89,162,8,36,35,39,9,223,0,248,22,252,16,2,28,248, +159,34,8,49,35,89,162,8,36,35,39,9,223,0,248,22,252,17,2,28,248, 22,47,248,22,217,196,249,22,230,196,20,15,159,37,34,8,43,11,83,159,34, 93,80,159,34,8,48,35,89,162,8,64,38,46,2,116,223,0,28,248,80,158, 35,41,196,249,22,7,198,10,28,248,80,158,35,47,196,87,94,28,27,248,80, 158,36,43,197,28,248,22,47,248,22,217,194,249,22,230,194,20,15,159,37,34, -8,43,11,251,22,252,46,2,248,22,217,198,2,144,198,248,80,158,39,43,200, +8,43,11,251,22,252,47,2,248,22,217,198,2,144,198,248,80,158,39,43,200, 12,27,248,80,158,36,42,197,27,248,22,177,199,28,248,80,158,37,41,194,249, 22,7,194,10,28,248,80,158,37,47,194,87,94,28,27,248,80,158,38,43,195, 28,248,22,47,248,22,217,194,249,22,230,194,20,15,159,39,34,8,43,11,251, -22,252,46,2,248,22,217,200,2,144,200,248,80,158,41,43,198,12,251,80,159, +22,252,47,2,248,22,217,200,2,144,200,248,80,158,41,43,198,12,251,80,159, 40,8,48,35,199,200,248,80,158,41,42,198,248,22,177,197,249,22,7,248,22, 177,195,11,249,22,7,248,22,177,199,11,83,159,34,93,80,159,34,34,35,89, 162,34,35,38,2,6,223,0,28,248,22,47,248,22,217,195,249,22,230,195,20, @@ -971,41 +971,41 @@ 193,192,27,248,22,58,194,28,248,22,213,193,192,27,248,22,58,194,28,248,22, 213,193,192,248,2,174,248,22,58,194,248,22,58,194,193,250,2,173,195,248,22, 177,197,248,22,59,198,195,34,196,83,159,34,93,80,159,34,38,35,32,175,89, -162,34,36,38,2,14,222,28,249,22,252,18,2,194,195,248,22,65,193,249,22, +162,34,36,38,2,14,222,28,249,22,252,19,2,194,195,248,22,65,193,249,22, 65,194,195,83,159,34,93,80,159,34,39,35,89,162,8,36,40,54,2,16,223, 0,91,159,37,11,90,161,37,34,11,26,9,80,159,46,8,47,35,205,206,23, 16,23,17,23,15,23,15,10,10,11,28,200,27,247,22,116,87,94,251,32,176, 89,162,8,100,38,44,2,116,222,28,248,22,213,196,27,250,22,122,196,248,22, 217,200,9,87,94,28,249,22,5,89,162,8,36,35,38,9,223,6,249,22,228, -195,194,194,251,22,252,46,2,248,22,217,199,6,30,30,118,97,114,105,97,98, +195,194,194,251,22,252,47,2,248,22,217,199,6,30,30,118,97,114,105,97,98, 108,101,32,117,115,101,100,32,116,119,105,99,101,32,105,110,32,112,97,116,116, 101,114,110,177,199,200,12,250,22,121,196,248,22,217,200,249,22,57,201,197,28, 248,22,56,196,87,94,251,2,176,196,197,198,248,22,58,200,251,2,176,196,197, -198,248,22,59,200,12,196,201,202,197,193,28,249,22,252,20,2,194,21,95,2, +198,248,22,59,200,12,196,201,202,197,193,28,249,22,252,21,2,194,21,95,2, 126,93,2,127,2,127,28,201,21,95,2,126,94,2,127,2,156,2,127,21,95, 2,126,93,2,127,2,127,250,22,65,2,126,249,22,67,2,127,249,80,158,44, 52,28,23,16,21,93,2,156,9,9,248,80,159,41,46,35,196,83,159,34,93, 80,159,34,53,35,89,162,34,39,46,2,46,223,0,253,80,158,40,39,199,200, 201,202,11,203,83,159,34,93,80,159,34,54,35,89,162,34,38,45,2,48,223, 0,253,80,158,40,39,199,200,201,202,10,11,83,159,34,93,80,159,34,46,35, -32,178,89,162,34,35,38,2,31,222,28,28,248,22,56,193,28,249,22,252,18, -2,248,22,58,195,2,126,249,22,252,20,2,248,22,84,195,21,93,2,127,11, +32,178,89,162,34,35,38,2,31,222,28,28,248,22,56,193,28,249,22,252,19, +2,248,22,58,195,2,126,249,22,252,21,2,248,22,84,195,21,93,2,127,11, 11,248,22,93,193,249,22,67,194,21,93,2,127,83,159,34,93,80,159,34,48, 35,32,179,89,162,34,36,40,2,35,222,28,28,248,22,56,193,28,249,22,252, -18,2,248,22,58,195,2,126,249,22,252,20,2,248,22,84,195,21,93,2,127, -11,11,27,248,22,93,194,28,249,22,252,18,2,194,2,127,194,28,28,248,22, -56,193,28,249,22,252,18,2,248,22,58,195,2,130,28,248,22,56,248,22,59, -194,28,249,22,252,18,2,248,22,84,195,2,127,248,22,63,248,22,86,194,11, +19,2,248,22,58,195,2,126,249,22,252,21,2,248,22,84,195,21,93,2,127, +11,11,27,248,22,93,194,28,249,22,252,19,2,194,2,127,194,28,28,248,22, +56,193,28,249,22,252,19,2,248,22,58,195,2,130,28,248,22,56,248,22,59, +194,28,249,22,252,19,2,248,22,84,195,2,127,248,22,63,248,22,86,194,11, 11,11,11,249,22,65,2,130,196,249,22,65,195,196,249,22,65,194,195,83,159, 34,93,80,159,34,49,35,32,180,89,162,34,36,40,2,37,222,28,28,248,22, -56,193,28,249,22,252,18,2,248,22,58,195,2,130,28,248,22,56,248,22,59, +56,193,28,249,22,252,19,2,248,22,58,195,2,130,28,248,22,56,248,22,59, 194,248,22,63,248,22,86,194,11,11,11,250,22,65,2,150,248,22,84,196,196, 250,22,65,2,151,195,196,83,159,34,93,80,159,34,55,35,89,162,34,38,56, 2,50,223,0,91,159,36,10,90,161,35,34,10,195,90,161,35,35,10,89,162, 34,40,8,59,2,102,226,2,5,3,1,28,28,199,28,248,80,158,38,47,197, 27,248,80,158,39,42,198,28,248,80,158,39,47,193,28,27,248,80,158,40,43, 194,28,248,22,47,248,22,217,194,249,22,230,194,20,15,159,41,34,8,43,11, -248,22,252,16,2,27,248,80,158,41,43,200,28,248,22,47,248,22,217,194,249, +248,22,252,17,2,27,248,80,158,41,43,200,28,248,22,47,248,22,217,194,249, 22,230,194,20,15,159,42,34,8,43,11,11,11,11,11,91,159,40,11,90,161, 35,34,11,248,80,158,44,43,203,90,161,37,35,11,27,248,80,158,45,42,248, 80,158,46,42,205,27,248,80,158,46,43,248,80,158,47,42,206,28,28,248,80, @@ -1034,10 +1034,10 @@ 15,159,8,38,35,8,43,20,15,159,8,33,35,8,43,20,15,159,8,28,35, 8,43,20,15,159,57,35,8,43,20,15,159,52,35,8,43,20,15,159,47,35, 8,43,90,161,35,39,11,28,203,249,80,159,45,44,35,198,202,11,87,94,28, -248,22,63,198,251,22,1,22,252,46,2,66,115,121,110,116,97,120,181,6,48, +248,22,63,198,251,22,1,22,252,47,2,66,115,121,110,116,97,120,181,6,48, 48,110,111,32,112,97,116,116,101,114,110,32,118,97,114,105,97,98,108,101,115, 32,98,101,102,111,114,101,32,101,108,108,105,112,115,101,115,32,105,110,32,116, -101,109,112,108,97,116,101,182,28,249,22,252,18,2,205,201,248,22,65,204,249, +101,109,112,108,97,116,101,182,28,249,22,252,19,2,205,201,248,22,65,204,249, 22,65,205,201,12,27,28,204,249,22,2,89,162,34,35,43,9,226,12,10,15, 14,251,80,158,41,56,200,196,198,197,200,11,27,28,205,28,248,22,63,194,9, 28,248,22,85,194,27,248,22,59,195,28,248,22,63,193,9,28,248,22,85,193, @@ -1071,18 +1071,18 @@ 248,22,59,196,28,248,22,63,193,9,28,248,22,85,193,249,22,57,248,22,83, 195,248,2,184,248,22,59,196,248,2,184,248,22,59,194,11,27,28,23,15,248, 80,159,48,57,35,195,11,27,28,23,16,248,80,159,49,57,35,195,11,27,28, -248,22,63,196,12,28,248,22,63,197,251,22,1,22,252,46,2,2,181,6,29, +248,22,63,196,12,28,248,22,63,197,251,22,1,22,252,47,2,2,181,6,29, 29,116,111,111,32,109,97,110,121,32,101,108,108,105,112,115,101,115,32,105,110, -32,116,101,109,112,108,97,116,101,185,28,249,22,252,18,2,23,19,23,15,248, +32,116,101,109,112,108,97,116,101,185,28,249,22,252,19,2,23,19,23,15,248, 22,65,23,18,249,22,65,23,19,23,15,12,27,253,24,19,23,15,23,24,23, 25,10,23,27,23,28,27,253,24,20,23,18,28,23,25,249,22,71,205,206,11, 23,18,10,11,23,29,28,23,19,250,22,65,2,126,21,93,61,114,186,27,27, 27,249,22,2,89,162,8,36,35,43,9,225,25,30,27,250,80,159,39,58,35, 2,186,249,80,159,41,37,35,200,197,196,204,28,28,249,22,188,35,248,22,70, -195,28,249,22,188,34,23,17,28,248,22,63,202,249,22,252,20,2,200,21,95, +195,28,249,22,188,34,23,17,28,248,22,63,202,249,22,252,21,2,200,21,95, 2,126,93,2,186,94,63,99,97,114,187,2,186,11,11,11,248,22,58,193,28, 28,249,22,188,36,248,22,70,195,28,249,22,188,34,23,17,28,248,22,63,202, -249,22,252,20,2,200,21,95,2,126,93,2,186,95,2,130,94,2,187,2,186, +249,22,252,21,2,200,21,95,2,126,93,2,186,95,2,130,94,2,187,2,186, 94,64,99,97,100,114,188,2,186,11,11,11,250,22,67,2,137,21,95,2,126, 94,61,97,189,61,98,190,95,2,130,2,189,2,190,249,80,158,8,28,52,197, 9,27,250,22,67,2,137,250,22,65,2,126,64,118,97,108,115,191,249,22,65, @@ -1110,12 +1110,12 @@ 63,201,192,250,22,65,2,135,248,22,65,249,22,65,2,193,249,22,67,2,130, 249,80,158,8,32,52,249,22,2,89,162,8,36,35,43,9,225,34,39,36,250, 80,159,39,58,35,2,186,249,80,159,41,37,35,200,197,196,23,20,9,195,27, -248,80,159,57,59,35,199,28,249,22,252,18,2,194,2,158,193,250,22,65,2, +248,80,159,57,59,35,199,28,249,22,252,19,2,194,2,158,193,250,22,65,2, 192,196,195,12,28,248,80,158,38,47,197,27,248,80,158,39,43,198,28,28,200, 28,248,22,47,248,22,217,194,249,22,230,194,20,15,159,40,34,8,43,11,11, 28,28,248,80,158,39,47,248,80,158,40,42,199,248,80,158,39,41,248,80,158, 40,42,248,80,158,41,42,200,11,27,248,80,158,40,43,248,80,158,41,42,200, -253,215,198,205,198,11,23,16,23,17,251,22,252,46,2,2,181,6,30,30,109, +253,215,198,205,198,11,23,16,23,17,251,22,252,47,2,2,181,6,30,30,109, 105,115,112,108,97,99,101,100,32,101,108,108,105,112,115,101,115,32,105,110,32, 116,101,109,112,108,97,116,101,196,198,196,27,253,215,199,205,199,23,15,23,16, 23,17,27,253,216,248,80,158,47,42,206,206,23,15,23,16,23,17,23,18,28, @@ -1130,7 +1130,7 @@ 22,213,194,249,22,228,194,195,11,200,28,192,250,22,65,2,126,21,93,2,186, 250,80,159,44,58,35,2,186,249,80,159,46,36,35,205,206,23,15,87,95,28, 200,28,28,248,22,47,248,22,217,199,249,22,230,199,20,15,159,40,34,8,43, -11,251,22,252,46,2,2,181,6,30,30,109,105,115,112,108,97,99,101,100,32, +11,251,22,252,47,2,2,181,6,30,30,109,105,115,112,108,97,99,101,100,32, 101,108,108,105,112,115,101,115,32,105,110,32,116,101,109,112,108,97,116,101,198, 198,201,12,12,249,80,159,40,8,27,35,199,200,250,22,65,2,126,21,93,2, 186,249,22,65,2,157,202,28,28,28,248,22,47,248,22,217,198,249,22,230,198, @@ -1141,7 +1141,7 @@ 7,27,250,22,122,196,248,22,217,198,9,28,28,248,22,56,193,249,22,5,89, 162,8,36,35,38,9,223,4,249,22,228,195,194,194,11,12,250,22,121,196,248, 22,217,198,249,22,57,199,197,28,198,250,22,65,2,126,21,93,2,186,27,27, -248,80,159,44,59,35,198,28,28,248,22,56,193,249,22,252,18,2,248,22,58, +248,80,159,44,59,35,198,28,28,248,22,56,193,249,22,252,19,2,248,22,58, 195,78,112,97,116,116,101,114,110,45,115,117,98,115,116,105,116,117,116,101,199, 11,192,27,28,206,251,22,216,23,18,2,100,23,18,23,18,11,250,22,65,1, 26,100,97,116,117,109,45,62,115,121,110,116,97,120,45,111,98,106,101,99,116, @@ -1151,25 +1151,25 @@ 249,22,65,2,157,250,22,216,11,2,93,23,18,192,249,22,1,22,71,249,22, 124,197,32,202,89,162,8,36,36,36,9,222,193,83,159,34,93,80,159,34,59, 35,32,203,89,162,34,35,38,2,58,222,28,28,248,22,56,193,28,249,22,252, -18,2,248,22,58,195,2,126,249,22,252,20,2,248,22,84,195,21,93,2,186, +19,2,248,22,58,195,2,126,249,22,252,21,2,248,22,84,195,21,93,2,186, 11,11,248,22,93,193,249,22,67,194,21,93,2,186,83,159,34,93,80,159,34, 8,26,35,89,162,34,38,50,2,60,223,0,28,28,248,22,56,195,28,249,22, -252,18,2,248,22,58,197,2,157,28,249,22,252,18,2,248,22,84,197,248,80, -158,37,43,199,27,249,22,252,18,2,198,2,158,28,192,192,28,248,22,56,197, -28,249,22,252,18,2,248,22,58,199,2,157,249,22,252,18,2,248,22,84,199, +252,19,2,248,22,58,197,2,157,28,249,22,252,19,2,248,22,84,197,248,80, +158,37,43,199,27,249,22,252,19,2,198,2,158,28,192,192,28,248,22,56,197, +28,249,22,252,19,2,248,22,58,199,2,157,249,22,252,19,2,248,22,84,199, 248,80,158,38,42,200,11,11,11,11,11,249,22,65,2,157,198,28,28,248,22, -56,196,249,22,252,18,2,248,22,58,198,2,199,11,28,28,248,22,56,195,28, -249,22,252,18,2,248,22,58,197,2,157,249,22,252,18,2,248,22,84,197,248, +56,196,249,22,252,19,2,248,22,58,198,2,199,11,28,28,248,22,56,195,28, +249,22,252,19,2,248,22,58,197,2,157,249,22,252,19,2,248,22,84,197,248, 80,158,37,43,199,11,11,250,22,67,2,199,249,22,65,2,157,27,249,22,57, 248,22,84,203,248,22,101,204,28,248,22,213,200,252,22,216,204,197,204,204,204, -192,248,22,86,199,28,28,248,22,56,195,249,22,252,18,2,2,199,248,22,58, +192,248,22,86,199,28,28,248,22,56,195,249,22,252,19,2,2,199,248,22,58, 197,11,250,22,67,2,199,249,22,65,2,157,27,249,22,57,248,22,101,203,248, 22,101,204,28,248,22,213,200,252,22,216,204,197,204,204,204,192,249,80,158,39, 52,248,22,86,200,248,22,86,201,27,247,22,54,27,249,22,57,195,248,22,101, 200,27,28,248,22,213,197,252,22,216,201,198,201,201,201,193,252,22,67,2,199, -249,22,65,2,157,199,199,202,248,22,86,204,28,249,22,252,18,2,197,2,158, +249,22,65,2,157,199,199,202,248,22,86,204,28,249,22,252,19,2,197,2,158, 251,80,158,38,8,26,197,198,21,94,2,199,94,2,157,9,200,28,28,248,22, -56,196,28,249,22,252,18,2,248,22,58,198,2,157,27,248,22,58,197,249,22, +56,196,28,249,22,252,19,2,248,22,58,198,2,157,27,248,22,58,197,249,22, 190,44,249,80,159,39,8,30,35,196,45,11,11,251,80,158,38,8,26,197,198, 249,22,65,2,199,201,200,251,80,158,38,8,26,197,198,27,247,22,54,251,22, 65,2,199,249,22,65,2,157,198,196,204,200,83,159,34,93,80,159,34,8,29, @@ -1210,14 +1210,14 @@ 229,1,194,249,80,159,39,8,30,35,248,22,252,236,1,196,194,28,248,22,113, 194,248,22,177,249,80,159,40,8,30,35,248,22,114,197,248,22,178,196,35,35, 83,159,34,93,80,159,34,58,35,32,204,89,162,34,37,40,2,56,222,28,28, -194,249,22,188,195,196,11,28,249,22,252,18,2,195,34,192,28,249,22,252,18, -2,195,35,249,22,65,63,99,100,114,205,194,28,249,22,252,18,2,195,36,249, -22,65,64,99,100,100,114,206,194,28,249,22,252,18,2,195,37,249,22,65,65, -99,100,100,100,114,207,194,28,249,22,252,18,2,195,38,249,22,65,66,99,100, +194,249,22,188,195,196,11,28,249,22,252,19,2,195,34,192,28,249,22,252,19, +2,195,35,249,22,65,63,99,100,114,205,194,28,249,22,252,19,2,195,36,249, +22,65,64,99,100,100,114,206,194,28,249,22,252,19,2,195,37,249,22,65,65, +99,100,100,100,114,207,194,28,249,22,252,19,2,195,38,249,22,65,66,99,100, 100,100,100,114,208,194,250,22,65,69,108,105,115,116,45,116,97,105,108,209,195, -196,28,249,22,252,18,2,195,34,249,22,65,2,187,194,28,249,22,252,18,2, -195,35,249,22,65,2,188,194,28,249,22,252,18,2,195,36,249,22,65,65,99, -97,100,100,114,210,194,28,249,22,252,18,2,195,37,249,22,65,66,99,97,100, +196,28,249,22,252,19,2,195,34,249,22,65,2,187,194,28,249,22,252,19,2, +195,35,249,22,65,2,188,194,28,249,22,252,19,2,195,36,249,22,65,65,99, +97,100,100,114,210,194,28,249,22,252,19,2,195,37,249,22,65,66,99,97,100, 100,100,114,211,194,250,22,65,68,108,105,115,116,45,114,101,102,212,195,196,83, 159,34,93,80,159,34,44,35,89,162,34,36,41,2,27,223,0,250,80,159,37, 8,53,35,197,196,10,83,159,34,93,80,159,34,56,35,89,162,8,36,38,54, @@ -1232,11 +1232,11 @@ 22,58,201,248,22,58,198,10,28,248,22,56,193,252,2,213,198,199,200,248,22, 58,198,11,28,248,22,213,196,28,248,22,213,193,28,249,22,228,197,194,249,22, 57,196,10,11,11,11,28,248,22,213,195,28,248,22,213,196,28,249,22,228,196, -197,249,22,57,28,198,194,195,248,22,252,16,2,199,11,11,11,198,200,248,22, +197,249,22,57,28,198,194,195,248,22,252,17,2,199,11,11,11,198,200,248,22, 58,199,248,22,58,200,10,28,248,22,56,195,252,2,213,198,200,198,248,22,58, 200,11,28,248,22,213,194,28,248,22,213,195,28,249,22,228,195,196,249,22,57, -28,194,195,197,248,22,252,16,2,195,11,11,11,197,87,94,28,192,12,251,22, -1,22,252,46,2,2,181,6,49,49,116,111,111,32,102,101,119,32,101,108,108, +28,194,195,197,248,22,252,17,2,195,11,11,11,197,87,94,28,192,12,251,22, +1,22,252,47,2,2,181,6,49,49,116,111,111,32,102,101,119,32,101,108,108, 105,112,115,101,115,32,102,111,114,32,112,97,116,116,101,114,110,32,118,97,114, 105,97,98,108,101,32,105,110,32,116,101,109,112,108,97,116,101,214,27,28,248, 22,213,200,199,27,248,22,58,201,28,248,22,213,193,192,27,248,22,58,194,28, @@ -1247,7 +1247,7 @@ 248,22,213,193,192,27,248,22,58,194,28,248,22,213,193,192,27,248,22,58,194, 28,248,22,213,193,192,27,248,22,58,194,28,248,22,213,193,192,27,248,22,58, 194,28,248,22,213,193,192,27,248,22,58,194,28,248,22,213,193,192,248,2,215, -248,22,58,194,248,22,58,194,28,249,22,252,18,2,203,194,248,22,65,202,249, +248,22,58,194,248,22,58,194,28,249,22,252,19,2,203,194,248,22,65,202,249, 22,65,203,194,192,83,159,34,93,80,159,34,57,35,32,216,89,162,34,35,37, 2,54,222,249,22,2,32,217,89,162,8,36,35,44,9,222,28,248,22,213,193, 192,27,248,22,58,194,28,248,22,213,193,192,27,248,22,58,194,28,248,22,213, @@ -1260,20 +1260,20 @@ 22,213,193,192,27,248,22,58,194,28,248,22,213,193,192,248,2,218,248,22,58, 194,248,22,58,194,194,83,159,34,93,80,159,34,8,27,35,32,219,89,162,34, 36,38,2,62,222,249,22,3,89,162,34,35,42,9,223,2,28,248,22,56,194, -27,248,22,58,195,28,248,22,213,193,28,249,22,228,194,195,250,22,252,46,2, +27,248,22,58,195,28,248,22,213,193,28,249,22,228,194,195,250,22,252,47,2, 2,181,6,50,50,109,105,115,115,105,110,103,32,101,108,108,105,112,115,101,115, 32,119,105,116,104,32,112,97,116,116,101,114,110,32,118,97,114,105,97,98,108, 101,32,105,110,32,116,101,109,112,108,97,116,101,220,196,12,27,248,22,58,194, -28,248,22,213,193,28,249,22,228,194,196,250,22,252,46,2,2,181,2,220,197, +28,248,22,213,193,28,249,22,228,194,196,250,22,252,47,2,2,181,2,220,197, 12,249,32,221,89,162,8,64,36,41,2,116,222,28,248,22,213,194,28,249,22, -228,195,194,250,22,252,46,2,2,181,2,220,195,12,27,248,22,58,195,28,248, -22,213,193,28,249,22,228,194,195,250,22,252,46,2,2,181,2,220,196,12,27, -248,22,58,194,28,248,22,213,193,28,249,22,228,194,196,250,22,252,46,2,2, +228,195,194,250,22,252,47,2,2,181,2,220,195,12,27,248,22,58,195,28,248, +22,213,193,28,249,22,228,194,195,250,22,252,47,2,2,181,2,220,196,12,27, +248,22,58,194,28,248,22,213,193,28,249,22,228,194,196,250,22,252,47,2,2, 181,2,220,197,12,249,2,221,196,248,22,58,195,196,248,22,58,195,12,195,83, 159,34,93,80,159,34,40,35,89,162,34,35,41,2,18,223,0,28,248,80,158, 35,47,194,27,248,80,158,36,42,195,28,248,80,158,36,47,193,28,27,248,80, 158,37,43,194,28,248,22,47,248,22,217,194,249,22,230,194,20,15,159,38,34, -8,43,11,248,22,252,16,2,27,248,80,158,38,43,197,28,248,22,47,248,22, +8,43,11,248,22,252,17,2,27,248,80,158,38,43,197,28,248,22,47,248,22, 217,194,249,22,230,194,20,15,159,39,34,8,43,11,11,11,11,83,159,34,93, 80,159,34,45,35,32,222,89,162,34,36,39,2,29,222,249,32,223,89,162,8, 64,36,52,2,116,222,28,248,22,63,194,9,28,248,193,248,22,58,195,249,22, @@ -1301,49 +1301,49 @@ 35,47,194,28,27,248,80,158,36,43,195,28,248,80,158,36,47,193,28,27,248, 80,158,37,43,194,28,248,80,158,37,47,193,28,248,80,159,37,8,31,35,248, 80,158,38,43,194,248,80,159,37,8,31,35,248,80,158,38,42,194,11,28,248, -80,158,37,50,193,248,22,252,16,2,28,248,22,47,248,22,217,195,249,22,230, +80,158,37,50,193,248,22,252,17,2,28,248,22,47,248,22,217,195,249,22,230, 195,20,15,159,39,34,8,43,11,10,27,248,80,158,37,42,194,28,248,80,158, 37,47,193,28,248,80,159,37,8,31,35,248,80,158,38,43,194,248,80,159,37, -8,31,35,248,80,158,38,42,194,11,28,248,80,158,37,50,193,248,22,252,16, +8,31,35,248,80,158,38,42,194,11,28,248,80,158,37,50,193,248,22,252,17, 2,28,248,22,47,248,22,217,195,249,22,230,195,20,15,159,39,34,8,43,11, -10,11,28,248,80,158,36,50,193,248,22,252,16,2,28,248,22,47,248,22,217, +10,11,28,248,80,158,36,50,193,248,22,252,17,2,28,248,22,47,248,22,217, 195,249,22,230,195,20,15,159,38,34,8,43,11,10,27,248,80,158,36,42,195, 28,248,80,158,36,47,193,28,27,248,80,158,37,43,194,28,248,80,158,37,47, 193,28,248,80,159,37,8,31,35,248,80,158,38,43,194,248,80,159,37,8,31, -35,248,80,158,38,42,194,11,28,248,80,158,37,50,193,248,22,252,16,2,28, +35,248,80,158,38,42,194,11,28,248,80,158,37,50,193,248,22,252,17,2,28, 248,22,47,248,22,217,195,249,22,230,195,20,15,159,39,34,8,43,11,10,27, 248,80,158,37,42,194,28,248,80,158,37,47,193,28,248,80,159,37,8,31,35, 248,80,158,38,43,194,248,80,159,37,8,31,35,248,80,158,38,42,194,11,28, -248,80,158,37,50,193,248,22,252,16,2,28,248,22,47,248,22,217,195,249,22, +248,80,158,37,50,193,248,22,252,17,2,28,248,22,47,248,22,217,195,249,22, 230,195,20,15,159,39,34,8,43,11,10,11,28,248,80,158,36,50,193,248,22, -252,16,2,28,248,22,47,248,22,217,195,249,22,230,195,20,15,159,38,34,8, -43,11,10,11,28,248,80,158,35,50,194,248,22,252,16,2,28,248,22,47,248, +252,17,2,28,248,22,47,248,22,217,195,249,22,230,195,20,15,159,38,34,8, +43,11,10,11,28,248,80,158,35,50,194,248,22,252,17,2,28,248,22,47,248, 22,217,196,249,22,230,196,20,15,159,37,34,8,43,11,10,83,159,34,97,80, 159,34,8,32,35,80,159,34,8,33,35,80,159,34,8,34,35,80,159,34,8, -35,35,80,159,34,8,36,35,26,8,22,252,98,2,74,115,121,110,116,97,120, -45,109,97,112,112,105,110,103,228,11,36,34,11,9,247,22,252,121,2,89,162, -34,36,44,9,223,8,28,248,80,158,35,50,195,250,22,252,46,2,11,6,53, +35,35,80,159,34,8,36,35,26,8,22,252,99,2,74,115,121,110,116,97,120, +45,109,97,112,112,105,110,103,228,11,36,34,11,9,247,22,252,122,2,89,162, +34,36,44,9,223,8,28,248,80,158,35,50,195,250,22,252,47,2,11,6,53, 53,112,97,116,116,101,114,110,32,118,97,114,105,97,98,108,101,32,99,97,110, 110,111,116,32,98,101,32,117,115,101,100,32,111,117,116,115,105,100,101,32,111, -102,32,97,32,116,101,109,112,108,97,116,101,229,197,251,22,252,46,2,11,6, +102,32,97,32,116,101,109,112,108,97,116,101,229,197,251,22,252,47,2,11,6, 53,53,112,97,116,116,101,114,110,32,118,97,114,105,97,98,108,101,32,99,97, 110,110,111,116,32,98,101,32,117,115,101,100,32,111,117,116,115,105,100,101,32, 111,102,32,97,32,116,101,109,112,108,97,116,101,230,198,28,249,22,232,20,15, 159,40,36,8,43,248,80,158,41,43,201,248,80,158,39,43,248,80,158,40,42, -200,248,80,158,39,43,199,83,159,34,93,80,159,34,8,37,35,249,22,252,100, -2,80,158,36,8,35,34,83,159,34,93,80,159,34,8,38,35,249,22,252,100, +200,248,80,158,39,43,199,83,159,34,93,80,159,34,8,37,35,249,22,252,101, +2,80,158,36,8,35,34,83,159,34,93,80,159,34,8,38,35,249,22,252,101, 2,80,158,36,8,35,35,83,159,34,93,80,159,34,8,39,35,89,162,34,36, -40,2,86,223,0,248,22,252,108,3,249,80,158,37,8,33,196,197,83,159,34, -93,80,159,34,8,40,35,89,162,34,35,38,2,88,223,0,28,248,22,252,109, -3,194,248,80,158,35,8,34,248,22,252,110,3,195,11,83,159,34,93,80,159, +40,2,86,223,0,248,22,252,109,3,249,80,158,37,8,33,196,197,83,159,34, +93,80,159,34,8,40,35,89,162,34,35,38,2,88,223,0,28,248,22,252,110, +3,194,248,80,158,35,8,34,248,22,252,111,3,195,11,83,159,34,93,80,159, 34,8,41,35,89,162,34,35,38,2,90,223,0,248,80,158,35,8,37,248,22, -252,110,3,195,83,159,34,93,80,159,34,8,42,35,89,162,34,35,38,2,92, -223,0,248,80,158,35,8,38,248,22,252,110,3,195,95,2,4,2,20,2,94, +252,111,3,195,83,159,34,93,80,159,34,8,42,35,89,162,34,35,38,2,92, +223,0,248,80,158,35,8,38,248,22,252,111,3,195,95,2,4,2,20,2,94, 9,2,4,0}; EVAL_ONE_SIZED_STR((char *)expr, 13716); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,178,252,180,24,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,178,252,180,24,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,69,35,37,115,116, 120,99,97,115,101,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99,159, 34,16,6,30,3,2,2,1,26,100,97,116,117,109,45,62,115,121,110,116,97, @@ -1375,9 +1375,9 @@ 159,41,41,35,196,195,197,27,28,248,22,193,248,22,119,195,196,91,159,35,11, 20,12,95,35,248,193,198,89,162,8,64,35,42,2,19,224,2,0,28,248,22, 56,195,27,248,194,248,22,58,197,27,248,195,248,22,59,198,28,28,249,22,252, -18,2,195,248,22,58,199,249,22,252,18,2,194,248,22,59,199,11,196,249,22, +19,2,195,248,22,58,199,249,22,252,19,2,194,248,22,59,199,11,196,249,22, 57,195,194,28,248,22,47,195,27,250,22,122,197,198,11,28,192,192,195,28,248, -22,213,195,27,248,194,248,22,217,197,28,249,22,252,18,2,248,22,217,198,194, +22,213,195,27,248,194,248,22,217,197,28,249,22,252,19,2,248,22,217,198,194, 195,251,22,216,199,196,199,199,28,248,22,252,229,1,195,248,22,252,237,1,249, 22,2,195,248,22,252,236,1,198,28,248,22,113,195,248,22,111,248,194,248,22, 114,197,194,250,22,216,20,15,159,42,34,39,251,22,67,2,15,199,249,22,65, @@ -1404,8 +1404,8 @@ 110,116,105,102,105,101,114,63,42,2,30,43,2,35,69,115,116,120,45,112,97, 105,114,63,44,11,16,1,18,101,64,104,101,114,101,45,43,98,41,10,34,11, 95,159,2,8,9,11,159,74,35,37,115,109,97,108,108,45,115,99,104,101,109, -101,46,9,11,159,2,35,9,11,16,14,2,4,2,2,2,18,2,2,2,15, -2,2,2,16,2,2,2,6,2,2,2,17,2,2,2,13,2,2,98,40,10, +101,46,9,11,159,2,35,9,11,16,14,2,17,2,2,2,16,2,2,2,6, +2,2,2,18,2,2,2,4,2,2,2,15,2,2,2,13,2,2,98,40,10, 35,11,95,159,64,35,37,115,99,47,9,11,159,2,46,9,11,159,2,35,9, 11,16,0,96,39,8,254,1,11,16,0,16,4,38,11,63,115,116,120,48,3, 1,7,101,110,118,50,56,53,49,49,16,6,37,11,63,112,97,116,50,64,115, @@ -1427,21 +1427,21 @@ 35,10,249,22,2,32,61,89,162,8,36,35,38,9,222,250,22,216,195,247,22, 54,11,209,90,161,35,36,10,248,22,178,248,22,70,209,27,28,248,22,58,23, 18,248,22,65,20,15,159,44,42,43,200,27,252,80,158,49,41,23,19,205,205, -248,80,158,50,35,23,21,248,22,252,16,2,23,19,27,28,206,249,22,252,20, +248,80,158,50,35,23,21,248,22,252,17,2,23,19,27,28,206,249,22,252,21, 2,195,21,95,66,108,97,109,98,100,97,62,93,61,101,63,2,63,249,22,252, -20,2,195,21,95,2,62,94,2,63,79,109,111,100,117,108,101,45,105,100,101, +21,2,195,21,95,2,62,94,2,63,79,109,111,100,117,108,101,45,105,100,101, 110,116,105,102,105,101,114,61,63,64,2,63,27,250,22,65,20,15,159,49,43, 43,248,22,65,249,22,65,23,20,28,199,23,19,250,22,67,250,22,216,20,15, 159,58,44,43,206,23,22,23,22,28,23,24,9,248,22,65,23,28,251,22,65, 20,15,159,53,45,43,28,200,10,23,21,250,22,65,20,15,159,56,46,43,250, 22,2,89,162,8,36,36,47,9,226,25,27,19,17,249,22,65,199,27,249,80, -158,42,42,201,212,27,28,249,22,188,214,195,28,249,22,252,18,2,195,34,64, -116,97,105,108,65,28,249,22,252,18,2,195,35,20,15,159,41,47,43,28,249, -22,252,18,2,195,36,20,15,159,41,48,43,28,249,22,252,18,2,195,37,20, -15,159,41,49,43,28,249,22,252,18,2,195,38,20,15,159,41,50,43,2,65, -28,249,22,252,18,2,195,34,20,15,159,41,51,43,28,249,22,252,18,2,195, -35,20,15,159,41,52,43,28,249,22,252,18,2,195,36,20,15,159,41,53,43, -28,249,22,252,18,2,195,37,20,15,159,41,54,43,11,28,249,22,252,18,2, +158,42,42,201,212,27,28,249,22,188,214,195,28,249,22,252,19,2,195,34,64, +116,97,105,108,65,28,249,22,252,19,2,195,35,20,15,159,41,47,43,28,249, +22,252,19,2,195,36,20,15,159,41,48,43,28,249,22,252,19,2,195,37,20, +15,159,41,49,43,28,249,22,252,19,2,195,38,20,15,159,41,50,43,2,65, +28,249,22,252,19,2,195,34,20,15,159,41,51,43,28,249,22,252,19,2,195, +35,20,15,159,41,52,43,28,249,22,252,19,2,195,36,20,15,159,41,53,43, +28,249,22,252,19,2,195,37,20,15,159,41,54,43,11,28,249,22,252,19,2, 194,2,65,28,248,22,193,194,198,250,22,65,20,15,159,44,55,43,201,196,28, 192,249,22,65,194,200,250,22,65,20,15,159,44,56,43,201,196,24,17,24,18, 251,22,65,20,15,159,8,26,57,43,251,22,2,80,159,8,30,8,42,35,24, @@ -1463,18 +1463,18 @@ 37,39,196,248,80,158,35,37,248,80,158,36,39,195,11,89,162,8,36,35,8, 33,9,223,0,91,159,35,10,90,161,35,34,10,28,248,80,158,36,34,195,248, 22,59,248,80,158,37,35,196,11,87,94,28,28,248,80,158,36,34,195,249,22, -190,248,22,70,210,37,11,12,250,22,252,46,2,11,6,8,8,98,97,100,32, +190,248,22,70,210,37,11,12,250,22,252,47,2,11,6,8,8,98,97,100,32, 102,111,114,109,68,197,27,248,22,58,209,27,248,22,84,210,27,248,22,93,211, 27,248,22,96,212,27,248,22,96,248,22,59,214,27,248,22,95,248,22,59,215, -87,96,28,248,80,158,42,34,195,12,250,22,252,46,2,248,22,217,201,6,56, +87,96,28,248,80,158,42,34,195,12,250,22,252,47,2,248,22,217,201,6,56, 56,101,120,112,101,99,116,101,100,32,97,32,112,97,114,101,110,116,104,101,115, 105,122,101,100,32,115,101,113,117,101,110,99,101,32,111,102,32,108,105,116,101, 114,97,108,32,105,100,101,110,116,105,102,105,101,114,115,69,197,249,22,3,89, -162,34,35,41,9,224,9,7,28,248,80,158,36,36,195,12,250,22,252,46,2, +162,34,35,41,9,224,9,7,28,248,80,158,36,36,195,12,250,22,252,47,2, 248,22,217,196,6,28,28,108,105,116,101,114,97,108,32,105,115,32,110,111,116, 32,97,110,32,105,100,101,110,116,105,102,105,101,114,70,197,248,80,158,44,35, 197,249,22,3,89,162,34,35,42,9,224,9,7,28,28,248,80,158,36,34,195, -250,22,191,36,248,22,70,248,80,158,40,35,199,37,11,12,250,22,252,46,2, +250,22,191,36,248,22,70,248,80,158,40,35,199,37,11,12,250,22,252,47,2, 248,22,217,196,6,10,10,98,97,100,32,99,108,97,117,115,101,71,197,194,27, 249,22,2,80,158,44,37,195,27,249,22,2,80,159,45,8,39,35,196,27,249, 22,2,80,159,46,8,40,35,197,27,20,15,159,45,34,43,27,20,15,159,46, @@ -1569,14 +1569,14 @@ 195,27,248,22,178,195,28,248,22,193,193,193,27,248,22,65,195,27,248,22,178, 195,28,248,22,193,193,193,249,2,137,248,22,65,196,248,22,178,195,248,22,65, 196,248,22,178,195,194,192,83,159,34,93,80,159,34,49,35,89,162,8,36,35, -39,9,223,0,27,249,22,252,100,3,196,32,138,89,162,8,44,34,34,9,222, +39,9,223,0,27,249,22,252,101,3,196,32,138,89,162,8,44,34,34,9,222, 11,28,248,80,158,36,39,193,192,11,89,162,8,36,35,56,9,223,0,91,159, 35,10,90,161,35,34,10,20,15,159,35,34,44,87,94,28,28,248,80,158,36, 34,195,27,248,80,158,37,35,196,28,248,80,158,37,34,193,248,80,158,37,36, -248,80,158,38,35,194,11,11,12,250,22,252,46,2,11,6,8,8,98,97,100, +248,80,158,38,35,194,11,11,12,250,22,252,47,2,11,6,8,8,98,97,100, 32,102,111,114,109,139,197,250,22,216,210,27,248,80,158,40,37,248,80,158,41, 35,200,27,251,80,158,44,38,197,11,9,11,27,249,22,2,80,159,43,49,35, -195,28,28,28,248,22,63,193,10,248,22,252,16,2,249,22,5,32,140,89,162, +195,28,28,28,248,22,63,193,10,248,22,252,17,2,249,22,5,32,140,89,162, 8,36,35,35,9,222,192,195,248,80,158,42,40,195,11,249,22,65,20,15,159, 43,35,44,196,27,249,80,159,44,50,35,196,195,27,28,248,22,63,195,9,27, 27,248,22,59,198,27,248,22,59,198,28,248,22,63,193,9,27,249,32,141,89, @@ -1620,26 +1620,26 @@ 101,172,28,192,250,22,225,196,2,172,195,193,83,159,34,93,80,159,34,35,35, 89,162,34,37,39,2,6,223,0,247,248,22,8,89,162,8,32,35,44,9,226, 1,4,3,2,20,14,159,80,158,37,36,250,80,158,40,37,249,22,25,11,80, -158,42,36,22,252,192,2,89,162,34,35,39,9,225,5,4,7,248,193,89,162, -34,34,41,9,225,3,2,4,28,248,22,252,189,2,193,248,22,252,194,2,193, -251,22,252,46,2,2,17,6,47,47,105,110,99,111,109,112,97,116,105,98,108, +158,42,36,22,252,193,2,89,162,34,35,39,9,225,5,4,7,248,193,89,162, +34,34,41,9,225,3,2,4,28,248,22,252,190,2,193,248,22,252,195,2,193, +251,22,252,47,2,2,17,6,47,47,105,110,99,111,109,112,97,116,105,98,108, 101,32,101,108,108,105,112,115,105,115,32,109,97,116,99,104,32,99,111,117,110, 116,115,32,102,111,114,32,116,101,109,112,108,97,116,101,173,197,198,27,247,193, 89,162,8,36,34,35,9,223,0,192,83,159,34,93,80,159,34,38,35,65,100, 117,109,109,121,174,83,159,34,93,80,159,34,39,35,89,162,8,37,37,40,2, 15,223,0,91,159,35,11,20,12,95,35,248,193,195,89,162,8,64,35,46,2, 19,226,1,4,3,0,28,248,22,56,197,27,248,194,248,22,58,199,27,248,195, -248,22,59,200,28,28,249,22,252,18,2,195,248,22,58,201,249,22,252,18,2, +248,22,59,200,28,28,249,22,252,19,2,195,248,22,58,201,249,22,252,19,2, 194,248,22,59,201,11,198,249,22,57,195,194,28,248,22,47,197,28,248,22,63, -194,196,28,249,22,252,18,2,198,248,22,58,196,248,22,58,195,27,248,22,59, -195,27,248,22,59,197,28,248,22,63,194,198,28,249,22,252,18,2,200,248,22, +194,196,28,249,22,252,19,2,198,248,22,58,196,248,22,58,195,27,248,22,59, +195,27,248,22,59,197,28,248,22,63,194,198,28,249,22,252,19,2,200,248,22, 58,196,248,22,58,193,250,32,175,89,162,8,64,37,45,65,115,108,111,111,112, -176,222,28,248,22,63,194,192,28,249,22,252,18,2,194,248,22,58,196,248,22, +176,222,28,248,22,63,194,192,28,249,22,252,19,2,194,248,22,58,196,248,22, 58,195,27,248,22,59,195,27,248,22,59,197,28,248,22,63,194,194,28,249,22, -252,18,2,196,248,22,58,196,248,22,58,193,27,248,22,59,195,27,248,22,59, -195,28,248,22,63,194,196,28,249,22,252,18,2,198,248,22,58,196,248,22,58, +252,19,2,196,248,22,58,196,248,22,58,193,27,248,22,59,195,27,248,22,59, +195,28,248,22,63,194,196,28,249,22,252,19,2,198,248,22,58,196,248,22,58, 193,250,2,175,199,248,22,59,197,248,22,59,196,201,248,22,59,197,248,22,59, -196,28,248,22,213,197,27,248,194,248,22,217,199,28,249,22,252,18,2,248,22, +196,28,248,22,213,197,27,248,194,248,22,217,199,28,249,22,252,19,2,248,22, 217,200,194,197,28,248,22,213,193,192,27,252,22,216,203,198,203,11,203,27,249, 22,225,201,2,172,28,192,250,22,225,196,2,172,195,193,28,248,22,252,229,1, 197,248,22,252,237,1,249,22,2,195,248,22,252,236,1,200,28,248,22,113,197, @@ -1648,25 +1648,25 @@ EVAL_ONE_SIZED_STR((char *)expr, 6336); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,81,252,148,6,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,81,252,148,6,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,68,35,37,115,116, 120,108,111,99,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99,159,34, 16,1,30,3,2,2,68,114,101,108,111,99,97,116,101,4,254,1,16,0,11, 11,16,1,2,4,35,11,16,3,71,115,121,110,116,97,120,45,99,97,115,101, -5,70,115,121,110,116,97,120,47,108,111,99,6,72,115,121,110,116,97,120,45, -99,97,115,101,42,7,16,3,11,11,11,16,3,2,5,2,6,2,7,34,37, -95,16,5,93,2,7,89,162,34,35,51,9,223,0,27,28,248,80,158,36,34, +5,72,115,121,110,116,97,120,45,99,97,115,101,42,6,70,115,121,110,116,97, +120,47,108,111,99,7,16,3,11,11,11,16,3,2,5,2,6,2,7,34,37, +95,16,5,93,2,6,89,162,34,35,51,9,223,0,27,28,248,80,158,36,34, 195,249,80,158,37,35,248,80,158,38,36,197,27,248,80,158,39,37,198,28,248, 80,158,39,34,193,249,80,158,40,35,248,80,158,41,36,195,27,248,80,158,42, 37,196,28,248,80,158,42,34,193,249,80,158,43,35,248,80,158,44,36,195,27, 248,80,158,45,37,196,28,248,80,158,45,34,193,249,80,158,46,35,248,80,158, 47,36,195,27,248,80,158,48,37,196,28,248,80,158,48,38,193,248,80,158,48, 39,193,11,11,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248, -22,93,196,27,248,22,96,197,27,248,22,95,198,27,252,22,67,202,199,200,198, +22,93,196,27,248,22,96,197,27,248,22,95,198,27,252,22,67,202,198,199,200, 201,254,80,158,48,40,20,15,159,48,34,41,21,97,3,1,4,103,52,56,56, 8,3,1,4,103,52,56,55,9,3,1,4,103,52,56,54,10,3,1,4,103, 52,56,53,11,3,1,4,103,52,56,52,12,248,22,58,200,248,22,95,200,248, -22,93,200,248,22,84,200,248,22,96,200,250,22,252,46,2,11,6,10,10,98, +22,96,200,248,22,93,200,248,22,84,200,250,22,252,47,2,11,6,10,10,98, 97,100,32,115,121,110,116,97,120,13,197,34,20,99,159,34,16,7,30,14,65, 35,37,115,116,120,15,69,115,116,120,45,112,97,105,114,63,16,11,30,17,2, 15,67,99,111,110,115,47,35,102,18,1,30,19,2,15,67,115,116,120,45,99, @@ -1677,8 +1677,8 @@ 105,116,117,116,101,29,0,16,1,18,158,165,40,100,73,115,121,110,116,97,120, 45,99,97,115,101,42,42,30,42,98,40,10,34,11,95,159,74,35,37,100,101, 102,105,110,101,45,101,116,45,97,108,31,9,11,159,2,28,9,11,159,71,35, -37,113,113,45,97,110,100,45,111,114,32,9,11,16,8,2,5,2,2,2,6, -2,2,2,4,2,2,2,7,2,2,98,39,10,35,11,94,159,64,35,37,115, +37,113,113,45,97,110,100,45,111,114,32,9,11,16,8,2,5,2,2,2,4, +2,2,2,6,2,2,2,7,2,2,98,39,10,35,11,94,159,64,35,37,115, 99,33,9,11,159,2,28,9,11,16,0,96,38,8,254,1,11,16,0,16,4, 37,11,63,115,116,120,34,3,1,7,101,110,118,50,57,54,48,35,16,12,36, 11,3,1,4,103,52,55,57,36,3,1,4,103,52,56,48,37,3,1,4,103, @@ -1696,7 +1696,7 @@ 27,248,22,93,196,27,248,22,94,197,27,251,22,67,200,197,198,199,253,80,158, 46,40,20,15,159,46,34,41,21,96,3,1,4,103,52,57,54,48,3,1,4, 103,52,57,53,49,3,1,4,103,52,57,52,50,3,1,4,103,52,57,51,51, -248,22,58,199,248,22,94,199,248,22,93,199,248,22,84,199,250,22,252,46,2, +248,22,58,199,248,22,94,199,248,22,93,199,248,22,84,199,250,22,252,47,2, 11,2,13,197,34,20,99,159,34,16,7,2,14,2,17,2,19,2,21,2,23, 2,25,2,27,16,1,18,158,165,40,100,2,30,46,40,39,38,16,4,45,11, 2,34,3,1,7,101,110,118,50,57,56,51,52,16,10,44,11,3,1,4,103, @@ -1705,17 +1705,17 @@ 57,2,57,16,10,43,11,2,42,2,43,2,44,2,46,3,1,7,101,110,118, 50,57,57,49,58,2,58,2,58,2,58,158,2,48,46,158,11,46,158,2,49, 46,158,2,50,46,158,79,109,111,100,117,108,101,45,105,100,101,110,116,105,102, -105,101,114,61,63,59,46,2,51,46,46,11,16,5,93,2,6,89,162,34,35, +105,101,114,61,63,59,46,2,51,46,46,11,16,5,93,2,7,89,162,34,35, 47,9,223,0,27,28,248,80,158,36,34,195,249,80,158,37,35,248,80,158,38, 36,197,27,248,80,158,39,37,198,28,248,80,158,39,34,193,249,80,158,40,35, 248,80,158,41,36,195,27,248,80,158,42,37,196,28,248,80,158,42,34,193,249, 80,158,43,38,248,80,158,44,36,195,248,80,158,44,39,248,80,158,45,37,196, 11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196,28, -28,248,22,47,248,22,217,194,248,80,158,39,40,249,22,252,100,3,195,32,60, +28,248,22,47,248,22,217,194,248,80,158,39,40,249,22,252,101,3,195,32,60, 89,162,8,44,34,34,9,222,11,11,250,80,158,41,41,20,15,159,41,34,42, -21,93,3,1,4,103,53,48,48,61,195,27,249,22,67,196,195,251,80,158,43, +21,93,3,1,4,103,53,48,48,61,195,27,249,22,67,195,196,251,80,158,43, 41,20,15,159,43,35,42,21,94,3,1,4,103,53,48,50,62,3,1,4,103, -53,48,49,63,248,22,58,197,248,22,59,197,250,22,252,46,2,11,2,13,197, +53,48,49,63,248,22,59,197,248,22,58,197,250,22,252,47,2,11,2,13,197, 34,20,99,159,34,16,8,2,14,2,17,2,19,2,21,30,64,2,15,69,97, 112,112,101,110,100,47,35,102,65,0,30,66,2,15,71,115,116,120,45,110,117, 108,108,47,35,102,67,9,30,68,2,33,75,115,121,110,116,97,120,45,109,97, @@ -1732,7 +1732,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 1696); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,101,252,191,8,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,101,252,191,8,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,70,35,37,119,105, 116,104,45,115,116,120,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99, 159,35,16,7,30,3,2,2,76,119,105,116,104,45,115,121,110,116,97,120,45, @@ -1746,8 +1746,8 @@ 105,116,104,45,115,121,110,116,97,120,18,16,2,11,11,16,2,2,10,2,18, 35,36,93,16,5,93,2,18,87,94,83,159,34,93,80,159,34,56,35,89,162, 8,64,38,58,64,108,111,111,112,19,223,0,28,248,22,63,196,27,249,22,67, -196,197,251,80,158,39,42,20,15,159,39,40,48,21,94,3,1,4,103,53,49, -52,20,3,1,4,103,53,49,51,21,248,22,58,197,248,22,59,197,26,8,22, +197,196,251,80,158,39,42,20,15,159,39,40,48,21,94,3,1,4,103,53,49, +52,20,3,1,4,103,53,49,51,21,248,22,59,197,248,22,58,197,26,8,22, 65,73,115,121,110,116,97,120,45,99,97,115,101,42,42,22,11,10,248,22,58, 204,9,79,109,111,100,117,108,101,45,105,100,101,110,116,105,102,105,101,114,61, 63,23,249,22,65,248,22,58,23,15,251,80,159,48,56,35,23,15,23,16,248, @@ -1760,9 +1760,9 @@ 41,37,194,28,248,80,158,41,34,193,249,80,158,42,35,248,80,158,43,36,195, 27,248,80,158,44,37,196,28,248,80,158,44,39,193,248,80,158,44,40,193,11, 11,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196, -249,80,158,41,41,200,27,249,22,67,198,197,251,80,158,46,42,20,15,159,46, +249,80,158,41,41,200,27,249,22,67,197,198,251,80,158,46,42,20,15,159,46, 35,48,21,94,3,1,4,103,53,49,50,26,3,1,4,103,53,49,49,27,248, -22,58,197,248,22,59,197,27,28,248,80,158,38,34,195,249,80,158,39,35,248, +22,59,197,248,22,58,197,27,28,248,80,158,38,34,195,249,80,158,39,35,248, 80,158,40,36,197,27,248,80,158,41,37,198,28,248,80,158,41,34,193,249,80, 158,42,43,27,248,80,158,44,36,196,28,248,80,158,44,39,193,248,22,8,89, 162,34,35,41,9,224,10,1,27,249,22,2,89,162,34,35,46,9,224,4,5, @@ -1782,7 +1782,7 @@ 48,250,22,65,63,108,101,116,32,251,22,2,32,33,89,162,8,36,37,44,9, 222,249,22,65,194,250,22,65,1,20,100,97,116,117,109,45,62,115,121,110,116, 97,120,45,111,98,106,101,99,116,34,249,22,65,2,25,200,199,204,203,205,251, -80,159,56,56,35,23,15,206,204,202,23,16,250,22,252,46,2,11,6,10,10, +80,159,56,56,35,23,15,206,204,202,23,16,250,22,252,47,2,11,6,10,10, 98,97,100,32,115,121,110,116,97,120,35,197,34,20,99,159,35,16,14,30,36, 2,12,69,115,116,120,45,112,97,105,114,63,37,11,30,38,2,12,67,99,111, 110,115,47,35,102,39,1,30,40,2,12,67,115,116,120,45,99,97,114,41,5, @@ -1799,7 +1799,7 @@ 109,97,116,99,104,45,118,97,114,115,64,0,16,7,18,98,2,31,40,98,38, 10,34,11,96,159,2,52,9,11,159,74,35,37,115,109,97,108,108,45,115,99, 104,101,109,101,65,9,11,159,2,49,9,11,159,2,12,9,11,16,10,2,4, -2,2,2,18,2,2,2,10,2,2,2,8,2,2,2,6,2,2,98,37,10, +2,2,2,18,2,2,2,6,2,2,2,8,2,2,2,10,2,2,98,37,10, 35,11,97,159,66,35,37,99,111,110,100,66,9,11,159,71,35,37,113,113,45, 97,110,100,45,111,114,67,9,11,159,2,63,9,11,159,2,49,9,11,159,2, 52,9,11,16,0,96,36,8,254,1,11,16,0,16,4,35,11,61,120,68,3, @@ -1820,7 +1820,7 @@ 101,110,118,51,48,54,54,93,2,93,2,93,18,158,161,36,103,2,0,53,38, 37,36,35,45,44,47,50,16,4,52,11,2,19,3,1,7,101,110,118,51,48, 55,49,94,158,2,20,53,2,21,53,53,11,97,83,159,34,93,80,159,34,41, -35,89,162,34,35,44,9,223,0,248,247,22,252,106,3,28,248,22,47,195,249, +35,89,162,34,35,44,9,223,0,248,247,22,252,107,3,28,248,22,47,195,249, 22,216,11,87,94,83,160,36,11,80,158,37,35,248,22,177,80,158,38,35,248, 22,48,250,22,252,191,1,6,4,4,126,97,126,115,95,200,80,158,41,35,28, 248,22,252,143,1,195,249,22,216,11,87,94,83,160,36,11,80,158,37,35,248, @@ -1830,12 +1830,12 @@ 95,196,80,158,42,35,249,22,216,11,87,94,83,160,36,11,80,158,37,35,248, 22,177,80,158,38,35,248,22,48,250,22,252,191,1,2,95,64,116,101,109,112, 96,80,158,41,35,83,159,34,93,80,159,34,34,35,32,97,89,162,34,35,38, -2,4,222,250,22,252,46,2,2,18,6,20,20,98,105,110,100,105,110,103,32, +2,4,222,250,22,252,47,2,2,18,6,20,20,98,105,110,100,105,110,103,32, 109,97,116,99,104,32,102,97,105,108,101,100,98,195,83,159,34,93,80,158,34, 35,34,83,159,34,93,80,159,34,36,35,89,162,34,35,40,2,8,223,0,87, 94,83,160,36,11,80,158,34,35,248,22,177,80,158,35,35,248,22,48,250,22, 252,191,1,2,95,197,80,158,38,35,83,159,34,93,80,159,34,37,35,89,162, -34,35,39,2,10,223,0,87,94,28,248,80,158,35,38,194,12,250,22,252,47, +34,35,39,2,10,223,0,87,94,28,248,80,158,35,38,194,12,250,22,252,48, 2,2,10,6,11,11,115,121,110,116,97,120,32,112,97,105,114,99,196,27,248, 80,158,36,39,195,249,22,2,80,159,37,41,35,194,97,68,35,37,107,101,114, 110,101,108,100,2,12,2,49,2,65,2,52,98,2,100,2,52,2,49,2,63, @@ -1843,7 +1843,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2251); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,208,252,226,24,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,208,252,16,25,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,76,35,37,115,116, 120,99,97,115,101,45,115,99,104,101,109,101,1,29,2,11,11,10,10,10,34, 80,158,34,34,20,99,159,34,16,2,30,3,2,2,1,26,99,104,101,99,107, @@ -1852,23 +1852,23 @@ 101,114,63,7,2,16,0,11,11,16,0,34,11,16,26,2,4,1,20,103,101, 110,101,114,97,116,101,45,116,101,109,112,111,114,97,114,105,101,115,8,75,108, 101,116,114,101,99,45,115,121,110,116,97,120,101,115,9,64,108,101,116,42,10, -73,100,101,102,105,110,101,45,115,116,114,117,99,116,11,70,108,101,116,45,115, -121,110,116,97,120,12,73,108,101,116,114,101,99,45,115,121,110,116,97,120,13, -63,97,110,100,14,64,119,104,101,110,15,62,111,114,16,66,117,110,108,101,115, -115,17,72,115,121,110,116,97,120,45,114,117,108,101,115,18,66,115,121,110,116, -97,120,19,75,115,121,110,116,97,120,45,105,100,45,114,117,108,101,115,20,64, -99,111,110,100,21,71,115,121,110,116,97,120,45,99,97,115,101,22,72,115,121, -110,116,97,120,45,99,97,115,101,42,23,70,115,121,110,116,97,120,47,108,111, -99,24,66,108,101,116,47,101,99,25,63,108,101,116,26,70,113,117,97,115,105, +70,115,121,110,116,97,120,47,108,111,99,11,73,108,101,116,114,101,99,45,115, +121,110,116,97,120,12,70,108,101,116,45,115,121,110,116,97,120,13,63,97,110, +100,14,64,119,104,101,110,15,62,111,114,16,66,117,110,108,101,115,115,17,72, +115,121,110,116,97,120,45,114,117,108,101,115,18,66,115,121,110,116,97,120,19, +75,115,121,110,116,97,120,45,105,100,45,114,117,108,101,115,20,64,99,111,110, +100,21,71,119,105,116,104,45,115,121,110,116,97,120,22,66,108,101,116,47,101, +99,23,73,100,101,102,105,110,101,45,115,116,114,117,99,116,24,72,115,121,110, +116,97,120,45,99,97,115,101,42,25,63,108,101,116,26,70,113,117,97,115,105, 113,117,111,116,101,27,72,108,101,116,45,115,121,110,116,97,120,101,115,28,66, -108,101,116,114,101,99,29,71,119,105,116,104,45,115,121,110,116,97,120,30,67, +108,101,116,114,101,99,29,71,115,121,110,116,97,120,45,99,97,115,101,30,67, 45,100,101,102,105,110,101,31,74,45,100,101,102,105,110,101,45,115,121,110,116, 97,120,32,16,26,11,70,35,37,119,105,116,104,45,115,116,120,33,11,71,35, -37,113,113,45,97,110,100,45,111,114,34,74,35,37,100,101,102,105,110,101,45, -101,116,45,97,108,35,11,11,2,34,2,35,2,34,2,35,11,69,35,37,115, -116,120,99,97,115,101,36,11,66,35,37,99,111,110,100,37,68,35,37,115,116, -120,108,111,99,38,2,38,2,38,2,35,2,34,2,34,11,2,34,2,33,2, -35,2,35,16,26,2,4,2,8,2,9,2,10,2,11,2,12,2,13,2,14, +37,113,113,45,97,110,100,45,111,114,34,68,35,37,115,116,120,108,111,99,35, +11,11,2,34,74,35,37,100,101,102,105,110,101,45,101,116,45,97,108,36,2, +34,2,36,11,69,35,37,115,116,120,99,97,115,101,37,11,66,35,37,99,111, +110,100,38,2,33,2,36,2,36,2,35,2,34,2,34,11,2,34,2,35,2, +36,2,36,16,26,2,4,2,8,2,9,2,10,2,11,2,12,2,13,2,14, 2,15,2,16,2,17,2,18,2,19,2,20,2,21,2,22,2,23,2,24,2, 25,2,26,2,27,2,28,2,29,2,30,2,31,2,32,36,8,26,98,16,5, 93,2,9,87,94,83,159,34,93,80,159,34,52,35,89,162,35,35,41,9,223, @@ -1887,14 +1887,14 @@ 158,44,35,248,80,158,45,36,195,27,248,80,158,46,37,196,28,248,80,158,46, 39,193,248,80,158,46,41,193,11,11,11,11,28,192,27,248,22,58,194,27,248, 22,84,195,27,248,22,93,196,27,248,22,96,197,27,248,22,95,198,249,80,158, -43,44,202,27,251,22,67,201,202,200,199,250,80,158,47,45,89,162,34,34,45, +43,44,202,27,251,22,67,200,201,202,199,250,80,158,47,45,89,162,34,34,45, 9,224,13,3,252,80,158,40,46,20,15,159,40,35,47,21,95,3,1,4,103, 53,50,52,41,3,1,4,103,53,50,51,42,3,1,4,103,53,50,50,43,250, -22,2,80,159,43,52,35,248,22,84,201,248,22,58,201,248,22,93,198,248,22, +22,2,80,159,43,52,35,248,22,93,201,248,22,84,201,248,22,58,198,248,22, 94,198,21,98,1,22,108,101,116,114,101,99,45,115,121,110,116,97,120,101,115, 43,118,97,108,117,101,115,44,94,94,94,62,105,100,45,63,46,46,46,46,64, 101,120,112,114,47,2,46,9,65,98,111,100,121,49,48,64,98,111,100,121,49, -2,46,20,15,159,47,37,47,250,22,252,46,2,11,6,10,10,98,97,100,32, +2,46,20,15,159,47,37,47,250,22,252,47,2,11,6,10,10,98,97,100,32, 115,121,110,116,97,120,50,196,34,20,99,159,35,16,13,30,51,2,6,69,115, 116,120,45,112,97,105,114,63,52,11,30,53,2,6,67,99,111,110,115,47,35, 102,54,1,30,55,2,6,67,115,116,120,45,99,97,114,56,5,30,57,2,6, @@ -1903,15 +1903,15 @@ 30,63,2,6,73,115,116,120,45,99,104,101,99,107,47,101,115,99,64,7,30, 65,2,6,69,115,116,120,45,62,108,105,115,116,66,4,30,67,2,6,71,115, 116,120,45,110,117,108,108,47,35,102,68,9,30,69,2,6,70,115,116,120,45, -114,111,116,97,116,101,70,12,30,71,2,38,68,114,101,108,111,99,97,116,101, -72,0,30,73,2,36,1,20,99,97,116,99,104,45,101,108,108,105,112,115,105, -115,45,101,114,114,111,114,74,1,30,75,2,36,1,24,97,112,112,108,121,45, +114,111,116,97,116,101,70,12,30,71,2,35,68,114,101,108,111,99,97,116,101, +72,0,30,73,2,37,1,20,99,97,116,99,104,45,101,108,108,105,112,115,105, +115,45,101,114,114,111,114,74,1,30,75,2,37,1,24,97,112,112,108,121,45, 112,97,116,116,101,114,110,45,115,117,98,115,116,105,116,117,116,101,76,0,16, -4,18,98,64,104,101,114,101,77,40,98,38,10,34,11,97,159,2,38,9,11, -159,2,33,9,11,159,2,36,9,11,159,2,6,9,11,159,74,35,37,115,109, +4,18,98,64,104,101,114,101,77,40,98,38,10,34,11,97,159,2,35,9,11, +159,2,33,9,11,159,2,37,9,11,159,2,6,9,11,159,74,35,37,115,109, 97,108,108,45,115,99,104,101,109,101,78,9,11,16,14,2,18,2,2,2,9, -2,2,2,12,2,2,2,20,2,2,2,13,2,2,2,4,2,2,2,28,2, -2,98,37,10,35,11,97,159,2,38,9,11,159,2,33,9,11,159,2,36,9, +2,2,2,4,2,2,2,12,2,2,2,13,2,2,2,20,2,2,2,28,2, +2,98,37,10,35,11,97,159,2,35,9,11,159,2,33,9,11,159,2,37,9, 11,159,2,6,9,11,159,2,78,9,11,16,0,96,36,8,254,1,11,16,0, 16,4,35,11,63,115,116,120,79,3,1,7,101,110,118,51,48,56,53,80,18, 158,163,38,100,2,44,43,38,37,36,35,16,12,42,11,3,1,4,103,53,49, @@ -1922,7 +1922,7 @@ 88,2,88,158,2,41,43,158,9,43,158,2,42,43,2,43,43,43,18,158,95, 10,2,39,2,40,43,18,16,2,96,2,46,45,93,8,252,157,10,16,4,44, 11,61,114,89,3,1,7,101,110,118,51,49,49,49,90,95,9,8,252,157,10, -2,36,11,16,5,93,2,13,87,94,83,159,34,93,80,159,34,52,35,89,162, +2,37,11,16,5,93,2,12,87,94,83,159,34,93,80,159,34,52,35,89,162, 35,35,41,9,223,0,251,80,158,38,46,20,15,159,38,36,47,21,94,3,1, 4,103,53,51,48,91,3,1,4,103,53,51,49,92,248,22,58,198,248,22,84, 198,89,162,34,35,50,9,223,0,27,249,22,216,20,15,159,37,34,47,196,27, @@ -1937,12 +1937,12 @@ 248,80,158,43,34,193,249,80,158,44,35,248,80,158,45,36,195,27,248,80,158, 46,37,196,28,248,80,158,46,39,193,248,80,158,46,42,193,11,11,11,11,28, 192,27,248,22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22,96,197, -27,248,22,95,198,249,80,158,43,44,202,27,251,22,67,201,202,200,199,250,80, +27,248,22,95,198,249,80,158,43,44,202,27,251,22,67,200,201,202,199,250,80, 158,47,45,89,162,34,34,45,9,224,13,3,252,80,158,40,46,20,15,159,40, 35,47,21,95,3,1,4,103,53,51,52,93,3,1,4,103,53,51,51,94,3, -1,4,103,53,51,50,95,250,22,2,80,159,43,52,35,248,22,84,201,248,22, -58,201,248,22,93,198,248,22,94,198,21,98,2,44,94,94,93,2,45,2,47, -2,46,9,2,48,2,49,2,46,20,15,159,47,37,47,250,22,252,46,2,11, +1,4,103,53,51,50,95,250,22,2,80,159,43,52,35,248,22,93,201,248,22, +84,201,248,22,58,198,248,22,94,198,21,98,2,44,94,94,93,2,45,2,47, +2,46,9,2,48,2,49,2,46,20,15,159,47,37,47,250,22,252,47,2,11, 2,50,196,34,20,99,159,35,16,13,2,51,2,53,2,55,2,57,2,59,2, 61,2,63,2,67,2,65,2,69,2,71,2,73,2,75,16,4,18,98,2,77, 47,38,37,36,16,4,46,11,2,79,3,1,7,101,110,118,51,49,49,54,96, @@ -1954,7 +1954,7 @@ 103,2,103,158,2,93,50,158,9,50,158,2,94,50,2,95,50,50,18,158,95, 10,93,2,91,2,92,50,18,16,2,96,2,46,52,93,8,252,177,10,16,4, 51,11,2,89,3,1,7,101,110,118,51,49,52,49,104,95,9,8,252,177,10, -2,36,11,16,5,93,2,28,87,96,83,159,34,93,80,159,34,8,29,35,89, +2,37,11,16,5,93,2,28,87,96,83,159,34,93,80,159,34,8,29,35,89, 162,35,35,43,9,223,0,251,80,158,38,49,20,15,159,38,39,51,21,94,3, 1,4,103,53,52,55,105,3,1,4,103,53,52,54,106,248,22,58,198,249,22, 2,80,159,40,8,28,35,248,22,84,200,83,159,34,93,80,159,34,8,28,35, @@ -1980,20 +1980,20 @@ 44,39,194,248,22,8,89,162,34,35,41,9,224,10,2,27,249,22,2,89,162, 34,35,41,9,224,4,5,249,80,158,37,40,28,248,80,158,38,39,197,248,22, 65,248,80,158,39,41,198,11,194,248,80,158,39,41,196,28,248,22,63,193,9, -248,80,158,37,46,193,11,28,192,249,80,158,45,47,204,27,252,22,67,203,200, -202,204,205,250,80,158,49,48,89,162,34,34,46,9,224,15,3,253,80,158,41, +248,80,158,37,46,193,11,28,192,249,80,158,45,47,204,27,252,22,67,200,205, +202,203,204,250,80,158,49,48,89,162,34,34,46,9,224,15,3,253,80,158,41, 49,20,15,159,41,37,51,21,96,3,1,4,103,53,53,49,110,3,1,4,103, 53,53,48,111,3,1,4,103,53,52,57,112,3,1,4,103,53,52,56,113,250, -22,2,80,159,44,8,27,35,248,22,84,202,248,22,96,202,250,22,2,80,159, -44,8,29,35,248,22,95,202,248,22,84,202,248,22,58,199,248,22,93,199,21, +22,2,80,159,44,8,27,35,248,22,58,202,248,22,95,202,250,22,2,80,159, +44,8,29,35,248,22,84,202,248,22,58,202,248,22,96,199,248,22,93,199,21, 96,2,44,94,94,94,63,116,109,112,114,2,46,2,47,2,46,9,98,2,44, 94,94,94,2,45,2,46,95,66,118,97,108,117,101,115,115,94,1,23,109,97, 107,101,45,114,101,110,97,109,101,45,116,114,97,110,115,102,111,114,109,101,114, 116,94,72,113,117,111,116,101,45,115,121,110,116,97,120,117,2,114,2,46,2, 46,9,2,48,2,49,2,46,20,15,159,49,41,51,248,80,158,44,50,20,15, -159,44,42,51,250,22,252,46,2,11,2,50,196,34,20,99,159,37,16,17,2, +159,44,42,51,250,22,252,47,2,11,2,50,196,34,20,99,159,37,16,17,2, 51,2,53,2,55,2,57,2,59,2,61,2,63,2,65,2,67,2,69,30,118, -2,33,2,8,0,30,119,2,36,1,26,100,97,116,117,109,45,62,115,121,110, +2,33,2,8,0,30,119,2,37,1,26,100,97,116,117,109,45,62,115,121,110, 116,97,120,45,111,98,106,101,99,116,47,115,104,97,112,101,120,2,30,121,2, 6,71,115,116,120,45,114,111,116,97,116,101,42,122,13,2,71,2,73,2,75, 30,123,2,33,76,119,105,116,104,45,115,121,110,116,97,120,45,102,97,105,108, @@ -2011,13 +2011,13 @@ 108,2,109,8,27,18,158,95,10,2,105,158,2,115,2,106,8,27,18,158,95, 10,2,116,94,2,117,2,107,8,27,18,16,2,96,2,46,8,29,93,8,252, 208,10,16,4,8,28,11,2,89,3,1,7,101,110,118,51,49,56,53,137,95, -9,8,252,208,10,2,36,18,16,2,158,94,158,94,98,2,114,8,33,93,8, +9,8,252,208,10,2,37,18,16,2,158,94,158,94,98,2,114,8,33,93,8, 252,196,10,16,4,8,32,11,3,1,8,119,115,116,109,112,53,52,48,138,3, 1,7,101,110,118,51,49,55,50,139,16,4,8,31,11,3,1,4,103,53,52, 49,140,3,1,7,101,110,118,51,49,57,52,141,16,4,8,30,11,65,95,101, 108,115,101,142,3,1,7,101,110,118,51,49,57,53,143,158,2,46,8,33,8, 33,158,2,46,8,33,8,33,95,9,8,252,196,10,2,33,11,16,5,93,2, -12,87,94,83,159,34,93,80,159,34,52,35,89,162,35,35,41,9,223,0,251, +13,87,94,83,159,34,93,80,159,34,52,35,89,162,35,35,41,9,223,0,251, 80,158,38,46,20,15,159,38,36,47,21,94,3,1,4,103,53,53,55,144,3, 1,4,103,53,53,56,145,248,22,58,198,248,22,84,198,89,162,34,35,50,9, 223,0,27,249,22,216,20,15,159,37,34,47,196,27,28,248,80,158,37,34,194, @@ -2032,12 +2032,12 @@ 80,158,44,35,248,80,158,45,36,195,27,248,80,158,46,37,196,28,248,80,158, 46,39,193,248,80,158,46,42,193,11,11,11,11,28,192,27,248,22,58,194,27, 248,22,84,195,27,248,22,93,196,27,248,22,96,197,27,248,22,95,198,249,80, -158,43,44,202,27,251,22,67,201,202,200,199,250,80,158,47,45,89,162,34,34, +158,43,44,202,27,251,22,67,200,201,202,199,250,80,158,47,45,89,162,34,34, 45,9,224,13,3,252,80,158,40,46,20,15,159,40,35,47,21,95,3,1,4, 103,53,54,49,146,3,1,4,103,53,54,48,147,3,1,4,103,53,53,57,148, -250,22,2,80,159,43,52,35,248,22,84,201,248,22,58,201,248,22,93,198,248, +250,22,2,80,159,43,52,35,248,22,93,201,248,22,84,201,248,22,58,198,248, 22,94,198,21,97,2,28,94,94,93,2,45,2,47,2,46,2,48,2,49,2, -46,20,15,159,47,37,47,250,22,252,46,2,11,2,50,196,34,20,99,159,35, +46,20,15,159,47,37,47,250,22,252,47,2,11,2,50,196,34,20,99,159,35, 16,13,2,51,2,53,2,55,2,57,2,59,2,61,2,63,2,67,2,65,2, 69,2,71,2,73,2,75,16,4,18,98,2,77,8,35,38,37,36,16,4,8, 34,11,2,79,3,1,7,101,110,118,51,49,57,57,149,18,158,162,37,100,2, @@ -2049,7 +2049,7 @@ 156,158,2,146,8,38,158,2,147,8,38,2,148,8,38,8,38,18,158,95,10, 93,2,144,2,145,8,38,18,16,2,96,2,46,8,40,93,8,252,233,10,16, 4,8,39,11,2,89,3,1,7,101,110,118,51,50,50,52,157,95,9,8,252, -233,10,2,36,11,16,5,93,2,18,87,94,83,159,34,93,80,159,34,58,35, +233,10,2,37,11,16,5,93,2,18,87,94,83,159,34,93,80,159,34,58,35, 89,162,35,35,42,9,223,0,252,80,158,39,48,20,15,159,39,38,50,21,95, 3,1,4,103,53,55,49,158,3,1,4,103,53,55,48,159,3,1,4,103,53, 55,50,160,248,22,58,199,248,22,84,199,248,22,93,199,89,162,34,35,52,9, @@ -2067,23 +2067,23 @@ 194,27,248,22,84,195,27,248,22,93,196,27,248,22,96,197,27,248,22,95,198, 28,249,22,4,80,158,42,44,248,22,223,249,80,158,45,45,20,15,159,45,34, 50,200,27,249,22,216,20,15,159,43,35,50,249,22,2,89,162,8,36,35,41, -9,224,11,12,87,94,28,248,80,158,36,44,195,12,251,22,252,46,2,11,6, +9,224,11,12,87,94,28,248,80,158,36,44,195,12,251,22,252,47,2,11,6, 59,59,112,97,116,116,101,114,110,32,109,117,115,116,32,115,116,97,114,116,32, 119,105,116,104,32,97,110,32,105,100,101,110,116,105,102,105,101,114,44,32,102, 111,117,110,100,32,115,111,109,101,116,104,105,110,103,32,101,108,115,101,161,196, 198,248,22,49,248,22,50,248,22,217,197,248,22,223,249,80,158,48,45,20,15, 159,48,36,50,202,27,28,248,80,158,43,39,194,248,80,158,43,40,194,11,28, -192,249,80,158,44,46,203,27,252,22,67,205,206,200,202,203,250,80,158,48,47, +192,249,80,158,44,46,203,27,252,22,67,205,203,202,200,206,250,80,158,48,47, 89,162,34,34,46,9,224,14,3,252,80,158,40,48,20,15,159,40,37,50,21, 95,3,1,4,103,53,55,53,162,3,1,4,103,53,55,52,163,3,1,4,103, -53,55,51,164,248,22,84,198,248,22,58,198,251,22,2,80,159,44,58,35,248, -22,93,202,248,22,95,202,248,22,96,202,21,95,66,108,97,109,98,100,97,165, +53,55,51,164,248,22,95,198,248,22,58,198,251,22,2,80,159,44,58,35,248, +22,96,202,248,22,84,202,248,22,93,202,21,95,66,108,97,109,98,100,97,165, 93,61,120,166,100,73,115,121,110,116,97,120,45,99,97,115,101,42,42,167,2, 87,10,2,166,94,61,107,168,2,46,79,109,111,100,117,108,101,45,105,100,101, 110,116,105,102,105,101,114,61,63,169,94,158,65,100,117,109,109,121,170,67,112, -97,116,116,101,114,110,171,95,2,24,2,166,68,116,101,109,112,108,97,116,101, +97,116,116,101,114,110,171,95,2,11,2,166,68,116,101,109,112,108,97,116,101, 172,2,46,20,15,159,48,39,50,248,80,158,43,49,20,15,159,43,40,50,250, -22,252,46,2,11,2,50,202,250,22,252,46,2,11,2,50,197,34,20,99,159, +22,252,47,2,11,2,50,202,250,22,252,47,2,11,2,50,197,34,20,99,159, 35,16,16,2,51,2,53,2,55,2,57,2,59,2,61,2,65,2,63,2,67, 2,121,30,173,2,6,2,7,2,2,119,2,71,2,73,2,75,2,123,16,7, 18,100,2,133,8,44,38,37,36,16,4,8,43,11,2,79,3,1,7,101,110, @@ -2093,64 +2093,67 @@ 180,2,180,2,180,2,180,16,12,8,41,11,2,87,2,168,67,107,101,121,119, 111,114,100,181,2,171,2,172,3,1,7,101,110,118,51,50,52,54,182,2,182, 2,182,2,182,2,182,18,16,2,158,2,77,8,44,8,45,18,16,2,158,2, -133,8,44,8,46,18,158,95,102,2,165,8,49,38,37,36,8,43,8,42,8, -41,16,4,8,48,11,3,1,4,103,53,54,57,183,3,1,7,101,110,118,51, -50,54,53,184,16,4,8,47,11,2,170,3,1,7,101,110,118,51,50,54,54, -185,158,94,10,2,166,8,49,158,164,10,2,167,2,162,10,2,166,2,163,2, -169,2,164,8,49,8,49,18,158,95,10,158,2,158,2,159,95,2,24,2,166, -2,160,8,49,18,16,2,96,2,46,8,51,93,8,252,8,11,16,4,8,50, -11,2,89,3,1,7,101,110,118,51,50,55,48,186,95,9,8,252,8,11,2, -36,18,16,2,158,94,98,2,170,8,55,93,8,252,255,10,16,4,8,54,11, -3,1,8,119,115,116,109,112,53,54,55,187,3,1,7,101,110,118,51,50,53, -56,188,16,4,8,53,11,3,1,4,103,53,54,56,189,3,1,7,101,110,118, -51,50,55,53,190,16,4,8,52,11,2,142,3,1,7,101,110,118,51,50,55, -54,191,158,2,46,8,55,8,55,95,9,8,252,255,10,2,33,11,16,5,93, -2,20,87,94,83,159,34,93,80,159,34,54,35,89,162,35,35,41,9,223,0, -251,80,158,38,48,20,15,159,38,36,49,21,94,3,1,4,103,53,56,49,192, -3,1,4,103,53,56,48,193,248,22,58,198,248,22,84,198,89,162,34,35,48, -9,223,0,27,28,248,80,158,36,34,195,249,80,158,37,35,248,80,158,38,36, -197,27,248,80,158,39,37,198,28,248,80,158,39,34,193,249,80,158,40,38,27, -248,80,158,42,36,196,28,248,80,158,42,39,193,248,22,65,248,80,158,43,40, -194,11,27,248,80,158,42,37,196,28,248,80,158,42,39,193,248,22,8,89,162, -34,35,41,9,224,8,1,27,249,22,2,89,162,34,35,46,9,224,4,5,249, -80,158,37,41,28,248,80,158,38,34,197,249,80,158,39,35,248,80,158,40,36, -199,27,248,80,158,41,37,200,28,248,80,158,41,34,193,249,80,158,42,35,248, -80,158,43,36,195,248,80,158,43,42,248,80,158,44,37,196,11,11,194,248,80, -158,39,40,196,28,248,22,63,193,21,93,9,248,80,158,37,43,193,11,11,11, -28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22,94, -197,28,249,22,4,80,158,41,44,248,22,223,249,80,158,44,45,20,15,159,44, -34,49,199,249,80,158,41,46,200,27,251,22,67,201,202,200,199,250,80,158,45, -47,89,162,34,34,45,9,224,11,3,252,80,158,40,48,20,15,159,40,35,49, -21,95,3,1,4,103,53,56,52,194,3,1,4,103,53,56,51,195,3,1,4, -103,53,56,50,196,248,22,84,198,248,22,58,198,250,22,2,80,159,43,54,35, -248,22,93,201,248,22,94,201,21,94,1,21,109,97,107,101,45,115,101,116,33, -45,116,114,97,110,115,102,111,114,109,101,114,197,95,2,165,93,2,166,100,2, -167,2,87,10,2,166,94,2,168,2,46,2,169,94,2,171,95,2,24,2,166, -2,172,2,46,20,15,159,45,37,49,250,22,252,46,2,11,2,50,201,250,22, -252,46,2,11,2,50,197,34,20,99,159,35,16,15,2,51,2,53,2,55,2, -57,2,59,2,61,2,65,2,63,2,67,2,121,2,173,2,119,2,71,2,73, -2,75,16,4,18,100,2,133,8,59,38,37,36,16,4,8,58,11,2,166,3, -1,7,101,110,118,51,50,56,48,198,16,10,8,57,11,3,1,4,103,53,55, -54,199,3,1,4,103,53,55,55,200,3,1,4,103,53,55,56,201,3,1,4, -103,53,55,57,202,3,1,7,101,110,118,51,50,57,51,203,2,203,2,203,2, -203,16,10,8,56,11,2,87,2,168,2,171,2,172,3,1,7,101,110,118,51, -50,57,52,204,2,204,2,204,2,204,18,158,95,10,2,197,95,2,165,93,2, -166,163,2,167,2,194,10,2,166,2,195,2,169,2,196,8,59,18,158,95,10, -2,192,95,2,24,2,166,2,193,8,59,18,16,2,96,2,46,8,61,93,8, -252,32,11,16,4,8,60,11,2,89,3,1,7,101,110,118,51,51,48,52,205, -95,9,8,252,32,11,2,36,11,93,83,159,34,93,80,159,34,34,35,89,162, -34,35,37,2,4,223,0,248,22,8,89,162,8,36,35,40,9,224,1,2,27, -247,22,116,87,94,249,22,3,89,162,8,36,35,45,9,226,4,3,5,2,87, -94,28,248,80,158,38,35,197,12,250,22,252,47,2,2,4,6,19,19,108,105, -115,116,32,111,102,32,105,100,101,110,116,105,102,105,101,114,115,206,197,27,250, -22,122,196,248,22,217,201,9,87,94,28,249,22,5,89,162,8,36,35,38,9, -223,7,249,22,228,195,194,194,248,195,198,12,250,22,121,196,248,22,217,201,249, -22,57,202,197,195,11,98,68,35,37,107,101,114,110,101,108,207,2,78,2,6, -2,36,2,33,2,38,98,2,207,2,78,2,6,2,36,2,33,2,38,0}; - EVAL_ONE_SIZED_STR((char *)expr, 6382); +133,8,44,8,46,18,158,95,102,2,165,8,51,38,37,36,8,43,16,12,8, +50,11,2,175,2,176,2,177,2,178,2,179,2,180,2,180,2,180,2,180,2, +180,16,12,8,49,11,2,87,2,168,2,181,2,171,2,172,2,182,2,182,2, +182,2,182,2,182,16,4,8,48,11,3,1,4,103,53,54,57,183,3,1,7, +101,110,118,51,50,54,53,184,16,4,8,47,11,2,170,3,1,7,101,110,118, +51,50,54,54,185,158,94,10,2,166,8,51,158,164,10,2,167,2,162,10,2, +166,2,163,2,169,2,164,8,51,8,51,18,158,95,10,158,2,158,2,159,95, +2,11,2,166,2,160,8,51,18,16,2,96,2,46,8,53,93,8,252,8,11, +16,4,8,52,11,2,89,3,1,7,101,110,118,51,50,55,48,186,95,9,8, +252,8,11,2,37,18,16,2,158,94,98,2,170,8,57,93,8,252,255,10,16, +4,8,56,11,3,1,8,119,115,116,109,112,53,54,55,187,3,1,7,101,110, +118,51,50,53,56,188,16,4,8,55,11,3,1,4,103,53,54,56,189,3,1, +7,101,110,118,51,50,55,53,190,16,4,8,54,11,2,142,3,1,7,101,110, +118,51,50,55,54,191,158,2,46,8,57,8,57,95,9,8,252,255,10,2,33, +11,16,5,93,2,20,87,94,83,159,34,93,80,159,34,54,35,89,162,35,35, +41,9,223,0,251,80,158,38,48,20,15,159,38,36,49,21,94,3,1,4,103, +53,56,49,192,3,1,4,103,53,56,48,193,248,22,58,198,248,22,84,198,89, +162,34,35,48,9,223,0,27,28,248,80,158,36,34,195,249,80,158,37,35,248, +80,158,38,36,197,27,248,80,158,39,37,198,28,248,80,158,39,34,193,249,80, +158,40,38,27,248,80,158,42,36,196,28,248,80,158,42,39,193,248,22,65,248, +80,158,43,40,194,11,27,248,80,158,42,37,196,28,248,80,158,42,39,193,248, +22,8,89,162,34,35,41,9,224,8,1,27,249,22,2,89,162,34,35,46,9, +224,4,5,249,80,158,37,41,28,248,80,158,38,34,197,249,80,158,39,35,248, +80,158,40,36,199,27,248,80,158,41,37,200,28,248,80,158,41,34,193,249,80, +158,42,35,248,80,158,43,36,195,248,80,158,43,42,248,80,158,44,37,196,11, +11,194,248,80,158,39,40,196,28,248,22,63,193,21,93,9,248,80,158,37,43, +193,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,93,196, +27,248,22,94,197,28,249,22,4,80,158,41,44,248,22,223,249,80,158,44,45, +20,15,159,44,34,49,199,249,80,158,41,46,200,27,251,22,67,201,200,199,202, +250,80,158,45,47,89,162,34,34,45,9,224,11,3,252,80,158,40,48,20,15, +159,40,35,49,21,95,3,1,4,103,53,56,52,194,3,1,4,103,53,56,51, +195,3,1,4,103,53,56,50,196,248,22,94,198,248,22,58,198,250,22,2,80, +159,43,54,35,248,22,84,201,248,22,93,201,21,94,1,21,109,97,107,101,45, +115,101,116,33,45,116,114,97,110,115,102,111,114,109,101,114,197,95,2,165,93, +2,166,100,2,167,2,87,10,2,166,94,2,168,2,46,2,169,94,2,171,95, +2,11,2,166,2,172,2,46,20,15,159,45,37,49,250,22,252,47,2,11,2, +50,201,250,22,252,47,2,11,2,50,197,34,20,99,159,35,16,15,2,51,2, +53,2,55,2,57,2,59,2,61,2,65,2,63,2,67,2,121,2,173,2,119, +2,71,2,73,2,75,16,4,18,100,2,133,8,61,38,37,36,16,4,8,60, +11,2,166,3,1,7,101,110,118,51,50,56,48,198,16,10,8,59,11,3,1, +4,103,53,55,54,199,3,1,4,103,53,55,55,200,3,1,4,103,53,55,56, +201,3,1,4,103,53,55,57,202,3,1,7,101,110,118,51,50,57,51,203,2, +203,2,203,2,203,16,10,8,58,11,2,87,2,168,2,171,2,172,3,1,7, +101,110,118,51,50,57,52,204,2,204,2,204,2,204,18,158,95,10,2,197,95, +2,165,93,2,166,163,2,167,2,194,10,2,166,2,195,2,169,2,196,8,61, +18,158,95,10,2,192,95,2,11,2,166,2,193,8,61,18,16,2,96,2,46, +8,63,93,8,252,32,11,16,4,8,62,11,2,89,3,1,7,101,110,118,51, +51,48,52,205,95,9,8,252,32,11,2,37,11,93,83,159,34,93,80,159,34, +34,35,89,162,34,35,37,2,4,223,0,248,22,8,89,162,8,36,35,40,9, +224,1,2,27,247,22,116,87,94,249,22,3,89,162,8,36,35,45,9,226,4, +3,5,2,87,94,28,248,80,158,38,35,197,12,250,22,252,48,2,2,4,6, +19,19,108,105,115,116,32,111,102,32,105,100,101,110,116,105,102,105,101,114,115, +206,197,27,250,22,122,196,248,22,217,201,9,87,94,28,249,22,5,89,162,8, +36,35,38,9,223,7,249,22,228,195,194,194,248,195,198,12,250,22,121,196,248, +22,217,201,249,22,57,202,197,195,11,98,68,35,37,107,101,114,110,101,108,207, +2,78,2,6,2,37,2,33,2,35,98,2,207,2,78,2,6,2,37,2,33, +2,35,0}; + EVAL_ONE_SIZED_STR((char *)expr, 6428); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,112,252,186,12,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,112,252,186,12,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,67,35,37,113,113, 115,116,120,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99,159,34,16, 2,30,3,2,2,79,99,104,101,99,107,45,115,112,108,105,99,105,110,103,45, @@ -2160,7 +2163,7 @@ 105,99,105,110,103,9,71,113,117,97,115,105,115,121,110,116,97,120,10,75,113, 117,97,115,105,115,121,110,116,97,120,47,108,111,99,11,16,4,11,11,11,11, 16,4,2,8,2,9,2,10,2,11,34,38,94,16,5,94,2,8,2,9,27, -32,12,89,162,34,35,38,61,102,13,222,250,22,252,46,2,11,6,30,30,105, +32,12,89,162,34,35,38,61,102,13,222,250,22,252,47,2,11,6,30,30,105, 108,108,101,103,97,108,32,111,117,116,115,105,100,101,32,111,102,32,113,117,97, 115,105,115,121,110,116,97,120,14,195,249,22,7,194,194,37,20,99,159,34,16, 0,16,0,11,16,5,94,2,10,2,11,87,96,83,159,34,93,80,159,34,8, @@ -2175,7 +2178,7 @@ 8,30,35,201,202,198,248,22,178,205,205,89,162,34,36,48,9,226,8,9,14, 11,249,195,250,22,216,199,249,22,65,248,80,158,45,35,200,203,197,199,27,28, 248,80,158,38,36,195,28,249,22,230,196,20,15,159,39,37,43,9,11,11,28, -192,251,22,252,46,2,11,6,25,25,109,105,115,117,115,101,32,119,105,116,104, +192,251,22,252,47,2,11,6,25,25,109,105,115,117,115,101,32,119,105,116,104, 105,110,32,113,117,97,115,105,115,121,110,116,97,120,17,201,202,27,28,248,80, 158,39,34,196,249,80,158,40,38,27,248,80,158,42,35,199,28,248,80,158,42, 34,193,28,27,248,80,158,43,35,194,28,248,80,158,43,36,193,28,249,22,230, @@ -2201,7 +2204,7 @@ 10,0,249,197,250,22,216,199,249,22,57,199,203,199,249,22,71,197,201,253,80, 159,47,8,30,35,203,204,199,201,89,162,34,34,38,9,224,7,6,249,194,195, 9,198,27,28,248,80,158,40,36,197,28,249,22,230,198,20,15,159,41,44,43, -9,11,11,28,192,251,22,252,46,2,11,6,25,25,109,105,115,117,115,101,32, +9,11,11,28,192,251,22,252,47,2,11,6,25,25,109,105,115,117,115,101,32, 119,105,116,104,105,110,32,113,117,97,115,105,115,121,110,116,97,120,25,203,204, 27,28,248,80,158,41,34,198,28,27,248,80,158,42,35,199,28,248,80,158,42, 36,193,28,249,22,230,194,20,15,159,43,45,43,9,11,11,27,248,80,158,42, @@ -2237,7 +2240,7 @@ 248,80,158,40,35,196,27,248,80,158,41,37,197,28,248,80,158,41,34,193,249, 80,158,42,38,248,80,158,43,35,195,248,80,158,43,39,248,80,158,44,37,196, 11,11,28,192,27,248,22,58,194,27,248,22,59,195,250,199,201,195,80,159,42, -8,32,35,250,22,252,46,2,11,6,10,10,98,97,100,32,115,121,110,116,97, +8,32,35,250,22,252,47,2,11,6,10,10,98,97,100,32,115,121,110,116,97, 120,28,196,89,162,34,35,49,9,224,3,2,27,249,22,216,20,15,159,38,52, 43,197,27,28,248,80,158,38,34,194,249,80,158,39,41,248,80,158,40,35,196, 27,248,80,158,41,37,197,28,248,80,158,41,34,193,249,80,158,42,41,248,80, @@ -2245,7 +2248,7 @@ 45,38,248,80,158,46,35,195,248,80,158,46,39,248,80,158,47,37,196,11,11, 11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196,250,200,202, 195,89,162,8,36,35,40,9,224,9,4,250,22,65,20,15,159,38,53,43,195, -197,250,22,252,46,2,11,2,28,196,37,20,99,159,37,16,9,30,29,2,6, +197,250,22,252,47,2,11,2,28,196,37,20,99,159,37,16,9,30,29,2,6, 69,115,116,120,45,112,97,105,114,63,30,11,30,31,2,6,67,115,116,120,45, 99,97,114,32,5,30,33,2,6,71,105,100,101,110,116,105,102,105,101,114,63, 34,2,30,35,2,6,67,115,116,120,45,99,100,114,36,6,30,37,2,6,69, @@ -2303,13 +2306,13 @@ 7,101,110,118,51,52,52,48,108,2,108,2,108,16,4,8,44,11,2,52,3, 1,7,101,110,118,51,52,52,55,109,11,93,83,159,34,93,80,159,34,34,35, 89,162,8,36,36,40,2,4,223,0,87,94,28,248,80,158,35,35,194,12,250, -22,252,47,2,2,9,6,18,18,112,114,111,112,101,114,32,115,121,110,116,97, +22,252,48,2,2,9,6,18,18,112,114,111,112,101,114,32,115,121,110,116,97, 120,32,108,105,115,116,110,196,250,22,216,197,196,197,95,68,35,37,107,101,114, 110,101,108,111,2,50,2,6,95,2,111,2,50,2,6,0}; EVAL_ONE_SIZED_STR((char *)expr, 3270); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,204,252,159,24,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,204,252,159,24,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,68,35,37,100,101, 102,105,110,101,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99,159,34, 16,0,16,0,11,11,16,0,34,11,16,4,76,98,101,103,105,110,45,102,111, @@ -2322,7 +2325,7 @@ 197,27,248,80,158,39,37,198,28,248,80,158,39,34,193,27,28,248,22,213,194, 193,198,249,80,158,41,35,248,80,158,42,36,196,27,248,80,158,43,37,197,250, 22,216,198,195,198,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248, -22,86,196,28,248,80,158,39,45,194,250,22,252,46,2,11,27,249,22,216,20, +22,86,196,28,248,80,158,39,45,194,250,22,252,47,2,11,27,249,22,216,20, 15,159,44,49,49,204,27,28,248,80,158,44,34,194,249,80,158,45,35,248,80, 158,46,36,196,27,248,80,158,47,37,197,28,248,80,158,47,34,193,249,80,158, 48,44,248,80,158,49,36,195,248,80,158,49,48,248,80,158,50,37,196,11,11, @@ -2341,7 +2344,7 @@ 27,248,80,158,53,37,197,250,22,216,198,195,198,11,11,28,192,27,248,22,58, 194,27,248,22,84,195,27,248,22,86,196,6,31,31,98,97,100,32,115,121,110, 116,97,120,32,40,105,108,108,101,103,97,108,32,117,115,101,32,111,102,32,96, -46,39,41,10,250,22,252,46,2,11,6,10,10,98,97,100,32,115,121,110,116, +46,39,41,10,250,22,252,47,2,11,6,10,10,98,97,100,32,115,121,110,116, 97,120,11,198,201,250,80,159,41,8,41,35,200,201,202,250,80,159,38,8,41, 35,197,198,199,83,159,34,93,80,159,34,8,41,35,89,162,34,37,49,2,7, 223,0,27,28,248,80,158,36,34,195,249,80,158,37,35,248,80,158,38,36,197, @@ -2349,25 +2352,25 @@ 198,249,80,158,41,35,248,80,158,42,36,196,27,248,80,158,43,37,197,250,22, 216,198,195,198,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22, 86,196,28,248,80,158,39,34,194,250,80,159,41,8,40,35,200,201,202,251,22, -252,46,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,12,202,197,250, +252,47,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,12,202,197,250, 80,159,38,8,40,35,197,198,199,83,159,34,93,80,159,34,8,40,35,89,162, 34,37,56,2,7,223,0,27,28,248,80,158,36,34,195,249,80,158,37,35,248, 80,158,38,36,197,27,248,80,158,39,37,198,28,248,80,158,39,34,193,27,28, 248,22,213,194,193,198,249,80,158,41,35,248,80,158,42,36,196,27,248,80,158, 43,37,197,250,22,216,198,195,198,11,11,28,192,27,248,22,58,194,27,248,22, 84,195,27,248,22,86,196,91,159,36,11,90,161,36,34,11,249,80,159,42,8, -38,35,202,197,87,95,28,248,80,158,41,38,195,12,250,22,252,46,2,11,6, +38,35,202,197,87,95,28,248,80,158,41,38,195,12,250,22,252,47,2,11,6, 50,50,98,97,100,32,115,121,110,116,97,120,32,40,105,108,108,101,103,97,108, 32,117,115,101,32,111,102,32,96,46,39,32,102,111,114,32,112,114,111,99,101, 100,117,114,101,32,98,111,100,121,41,13,203,28,248,80,158,41,47,195,250,22, -252,46,2,11,6,46,46,98,97,100,32,115,121,110,116,97,120,32,40,110,111, +252,47,2,11,6,46,46,98,97,100,32,115,121,110,116,97,120,32,40,110,111, 32,101,120,112,114,101,115,115,105,111,110,115,32,102,111,114,32,112,114,111,99, 101,100,117,114,101,32,98,111,100,121,41,14,203,12,27,249,22,216,20,15,159, 43,45,49,204,27,249,22,216,20,15,159,44,46,49,196,27,249,22,216,20,15, -159,45,47,49,248,199,200,249,80,158,45,41,205,27,250,22,67,198,199,200,252, +159,45,47,49,248,199,200,249,80,158,45,41,205,27,250,22,67,199,200,198,252, 80,158,51,42,20,15,159,51,48,49,21,95,3,1,4,103,54,53,51,15,3, -1,4,103,54,53,49,16,3,1,4,103,54,53,50,17,248,22,86,198,248,22, -84,198,248,22,58,198,250,22,252,46,2,11,2,11,197,83,159,34,93,80,159, +1,4,103,54,53,49,16,3,1,4,103,54,53,50,17,248,22,84,198,248,22, +58,198,248,22,86,198,250,22,252,47,2,11,2,11,197,83,159,34,93,80,159, 34,8,38,35,89,162,34,36,45,73,103,101,110,101,114,97,108,45,112,114,111, 116,111,18,223,0,27,249,22,216,20,15,159,37,43,49,197,27,28,248,80,158, 37,34,194,249,80,158,38,35,248,80,158,39,36,196,27,248,80,158,40,37,197, @@ -2385,11 +2388,11 @@ 35,204,203,249,22,7,195,89,162,34,35,40,9,224,4,2,248,194,248,22,65, 248,195,197,27,28,248,80,158,37,34,196,249,80,158,38,35,248,80,158,39,36, 198,27,248,80,158,40,37,199,250,22,216,201,195,201,11,28,192,27,248,22,58, -194,27,248,22,59,195,251,22,252,46,2,11,6,82,82,98,97,100,32,115,121, +194,27,248,22,59,195,251,22,252,47,2,11,6,82,82,98,97,100,32,115,121, 110,116,97,120,32,40,110,111,116,32,97,110,32,105,100,101,110,116,105,102,105, 101,114,32,102,111,114,32,112,114,111,99,101,100,117,114,101,32,110,97,109,101, 44,32,97,110,100,32,110,111,116,32,97,32,110,101,115,116,101,100,32,112,114, -111,99,101,100,117,114,101,32,102,111,114,109,41,21,203,197,250,22,252,46,2, +111,99,101,100,117,114,101,32,102,111,114,109,41,21,203,197,250,22,252,47,2, 11,2,11,198,83,159,34,93,80,159,34,8,37,35,89,162,8,100,36,57,72, 115,105,109,112,108,101,45,112,114,111,116,111,22,223,0,91,159,36,11,90,161, 36,34,11,27,249,22,216,20,15,159,39,35,49,199,27,28,248,80,158,39,34, @@ -2410,16 +2413,16 @@ 9,226,10,11,2,3,27,249,22,216,20,15,159,40,41,49,199,249,80,158,40, 41,197,27,250,22,67,199,198,200,251,80,158,45,42,20,15,159,45,42,49,21, 94,3,1,4,103,54,51,50,26,3,1,4,103,54,51,49,27,249,22,71,248, -22,58,199,248,22,86,199,248,22,84,197,250,22,252,46,2,11,2,11,197,87, +22,58,199,248,22,86,199,248,22,84,197,250,22,252,47,2,11,2,11,197,87, 95,249,22,3,89,162,34,35,41,9,224,4,5,28,248,80,158,36,45,195,12, -251,22,252,46,2,11,6,40,40,110,111,116,32,97,110,32,105,100,101,110,116, +251,22,252,47,2,11,6,40,40,110,111,116,32,97,110,32,105,100,101,110,116, 105,102,105,101,114,32,102,111,114,32,112,114,111,99,101,100,117,114,101,32,97, 114,103,117,109,101,110,116,28,196,198,194,27,248,80,158,38,46,194,28,192,251, -22,252,46,2,11,6,29,29,100,117,112,108,105,99,97,116,101,32,97,114,103, +22,252,47,2,11,6,29,29,100,117,112,108,105,99,97,116,101,32,97,114,103, 117,109,101,110,116,32,105,100,101,110,116,105,102,105,101,114,29,200,196,12,193, 27,89,162,8,36,35,36,62,109,107,30,223,1,89,162,34,35,52,9,224,0, -1,87,94,28,249,22,77,247,22,252,102,3,21,93,70,101,120,112,114,101,115, -115,105,111,110,31,250,22,252,46,2,11,6,36,36,110,111,116,32,97,108,108, +1,87,94,28,249,22,77,247,22,252,103,3,21,93,70,101,120,112,114,101,115, +115,105,111,110,31,250,22,252,47,2,11,6,36,36,110,111,116,32,97,108,108, 111,119,101,100,32,105,110,32,97,110,32,101,120,112,114,101,115,115,105,111,110, 32,99,111,110,116,101,120,116,32,197,12,27,249,22,216,20,15,159,38,34,49, 197,27,28,248,80,158,38,34,194,249,80,158,39,35,248,80,158,40,36,196,27, @@ -2428,9 +2431,9 @@ 44,248,80,158,46,36,195,248,80,158,46,48,248,80,158,47,37,196,11,11,11, 28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196,28,248,80,158, 41,45,194,27,249,22,216,20,15,159,43,50,49,200,249,80,158,43,41,202,27, -250,22,67,200,198,199,252,80,158,49,42,20,15,159,49,51,49,21,95,3,1, +250,22,67,199,200,198,252,80,158,49,42,20,15,159,49,51,49,21,95,3,1, 4,103,54,54,55,33,3,1,4,103,54,54,53,34,3,1,4,103,54,54,54, -35,248,22,84,198,248,22,58,198,248,22,86,198,250,80,159,43,8,42,35,199, +35,248,22,86,198,248,22,84,198,248,22,58,198,250,80,159,43,8,42,35,199, 202,200,250,80,159,40,8,42,35,196,199,197,250,22,7,248,196,20,15,159,39, 52,49,248,196,20,15,159,39,53,49,248,196,20,15,159,39,54,49,39,20,99, 159,40,16,15,30,36,65,35,37,115,116,120,37,69,115,116,120,45,112,97,105, @@ -2471,16 +2474,16 @@ 90,64,114,101,115,116,97,3,1,7,101,110,118,51,53,49,54,98,2,98,2, 98,18,16,2,158,93,103,2,25,8,26,98,59,10,34,11,95,159,68,35,37, 112,97,114,97,109,122,99,9,11,159,74,35,37,115,109,97,108,108,45,115,99, -104,101,109,101,100,9,11,159,2,37,9,11,16,14,2,51,29,101,11,11,78, -112,97,116,116,101,114,110,45,115,117,98,115,116,105,116,117,116,101,102,2,101, -2,56,2,101,73,115,121,110,116,97,120,45,99,97,115,101,42,42,103,2,101, -1,20,99,97,116,99,104,45,101,108,108,105,112,115,105,115,45,101,114,114,111, -114,104,2,101,66,115,121,110,116,97,120,105,2,101,75,115,117,98,115,116,105, -116,117,116,101,45,115,116,111,112,106,2,101,98,58,10,35,11,95,159,64,35, +104,101,109,101,100,9,11,159,2,37,9,11,16,14,66,115,121,110,116,97,120, +101,29,102,11,11,73,115,121,110,116,97,120,45,99,97,115,101,42,42,103,2, +102,1,20,99,97,116,99,104,45,101,108,108,105,112,115,105,115,45,101,114,114, +111,114,104,2,102,78,112,97,116,116,101,114,110,45,115,117,98,115,116,105,116, +117,116,101,105,2,102,2,51,2,102,2,56,2,102,75,115,117,98,115,116,105, +116,117,116,101,45,115,116,111,112,106,2,102,98,58,10,35,11,95,159,64,35, 37,115,99,107,9,11,159,2,100,9,11,159,2,37,9,11,16,0,96,57,8, 254,1,11,16,0,16,4,56,11,61,120,108,3,1,6,101,110,118,52,53,52, 109,16,4,55,11,68,104,101,114,101,45,115,116,120,110,3,1,6,101,110,118, -52,53,54,111,16,4,54,11,2,110,2,111,13,16,4,35,2,101,2,50,11, +52,53,54,111,16,4,54,11,2,110,2,111,13,16,4,35,2,102,2,50,11, 93,8,252,203,11,16,4,53,11,61,114,112,3,1,7,101,110,118,51,53,50, 51,113,8,26,95,9,8,252,203,11,2,50,18,16,2,158,2,70,52,8,27, 18,158,160,10,2,92,2,26,2,27,52,18,16,2,158,2,70,45,8,28,18, @@ -2511,12 +2514,12 @@ 80,158,38,36,197,27,248,80,158,39,38,198,28,248,80,158,39,40,193,248,80, 158,39,41,193,11,11,28,192,27,248,22,58,194,27,248,22,59,195,249,80,158, 39,42,199,250,80,158,42,43,20,15,159,42,36,45,21,93,3,1,4,103,54, -55,52,138,249,22,2,80,159,44,8,28,35,199,250,22,252,46,2,11,2,11, +55,52,138,249,22,2,80,159,44,8,28,35,199,250,22,252,47,2,11,2,11, 197,83,159,34,93,80,159,34,8,28,35,89,162,35,35,40,9,223,0,250,80, 158,37,43,20,15,159,37,37,45,21,93,3,1,4,103,54,55,51,139,248,22, -58,197,89,162,34,35,57,9,223,0,27,247,22,252,102,3,87,94,28,249,22, +58,197,89,162,34,35,57,9,223,0,27,247,22,252,103,3,87,94,28,249,22, 77,194,21,95,66,109,111,100,117,108,101,140,72,109,111,100,117,108,101,45,98, -101,103,105,110,141,69,116,111,112,45,108,101,118,101,108,142,12,250,22,252,46, +101,103,105,110,141,69,116,111,112,45,108,101,118,101,108,142,12,250,22,252,47, 2,11,6,51,51,97,108,108,111,119,101,100,32,111,110,108,121,32,97,116,32, 116,104,101,32,116,111,112,45,108,101,118,101,108,32,111,114,32,97,32,109,111, 100,117,108,101,32,116,111,112,45,108,101,118,101,108,143,197,27,249,22,216,20, @@ -2525,8 +2528,8 @@ 37,35,45,27,28,248,80,158,39,34,195,249,80,158,40,39,248,80,158,41,36, 197,27,248,80,158,42,38,198,28,248,80,158,42,34,193,249,80,158,43,35,248, 80,158,44,36,195,248,80,158,44,37,248,80,158,45,38,196,11,11,28,192,27, -248,22,58,194,27,248,22,59,195,28,249,22,252,18,2,199,2,141,249,80,159, -42,8,29,35,198,201,27,250,22,252,32,2,196,201,248,22,223,20,15,159,45, +248,22,58,194,27,248,22,59,195,28,249,22,252,19,2,199,2,141,249,80,159, +42,8,29,35,198,201,27,250,22,252,33,2,196,201,248,22,223,20,15,159,45, 38,45,27,249,22,216,20,15,159,44,39,45,195,27,28,248,80,158,44,34,194, 28,27,248,80,158,45,36,195,28,248,80,158,45,44,193,28,249,22,231,194,20, 15,159,46,40,45,9,11,11,27,248,80,158,45,38,195,28,248,80,158,45,40, @@ -2554,7 +2557,7 @@ 248,80,158,52,40,193,248,22,65,248,80,158,53,41,194,11,27,248,80,158,52, 38,196,28,248,80,158,52,34,193,249,80,158,53,35,248,80,158,54,36,195,248, 80,158,54,37,248,80,158,55,38,196,11,11,11,11,28,192,27,248,22,58,194, -27,248,22,59,195,250,22,252,46,2,11,6,54,54,115,121,110,116,97,120,32, +27,248,22,59,195,250,22,252,47,2,11,6,54,54,115,121,110,116,97,120,32, 100,101,102,105,110,105,116,105,111,110,115,32,110,111,116,32,97,108,108,111,119, 101,100,32,119,105,116,104,105,110,32,98,101,103,105,110,45,102,111,114,45,115, 121,110,116,97,120,149,204,250,80,158,50,43,20,15,159,50,49,45,21,93,3, @@ -2613,7 +2616,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 6315); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,252,2,2,252,21,68,159,34,20,99,159,34,16, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,252,2,2,252,73,68,159,34,20,99,159,34,16, 1,20,24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,73,35,37, 109,111,114,101,45,115,99,104,101,109,101,1,29,2,11,11,10,10,10,48,80, 158,34,34,20,99,159,34,16,28,30,3,2,2,74,115,116,114,117,99,116,58, @@ -2658,13 +2661,13 @@ 59,254,1,16,0,11,11,16,18,2,41,2,39,2,31,2,33,2,29,2,59, 2,57,2,37,2,27,2,6,2,10,2,55,2,53,2,43,2,12,2,35,2, 25,2,4,52,11,16,18,2,49,2,23,2,45,2,16,2,14,2,8,72,112, -97,114,97,109,101,116,101,114,105,122,101,60,65,100,101,108,97,121,61,64,116, -105,109,101,62,62,100,111,63,64,99,97,115,101,64,71,115,101,116,33,45,118, -97,108,117,101,115,65,66,108,101,116,47,99,99,66,73,119,105,116,104,45,104, -97,110,100,108,101,114,115,67,70,108,101,116,45,115,116,114,117,99,116,68,78, -112,97,114,97,109,101,116,101,114,105,122,101,45,98,114,101,97,107,69,74,119, -105,116,104,45,104,97,110,100,108,101,114,115,42,70,69,102,108,117,105,100,45, -108,101,116,71,16,18,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, +97,114,97,109,101,116,101,114,105,122,101,60,70,108,101,116,45,115,116,114,117, +99,116,61,65,100,101,108,97,121,62,73,119,105,116,104,45,104,97,110,100,108, +101,114,115,63,71,115,101,116,33,45,118,97,108,117,101,115,64,66,108,101,116, +47,99,99,65,78,112,97,114,97,109,101,116,101,114,105,122,101,45,98,114,101, +97,107,66,62,100,111,67,64,99,97,115,101,68,74,119,105,116,104,45,104,97, +110,100,108,101,114,115,42,69,69,102,108,117,105,100,45,108,101,116,70,64,116, +105,109,101,71,16,18,11,11,11,11,11,11,11,11,11,11,11,11,11,11,11, 11,11,11,16,18,2,49,2,23,2,45,2,16,2,14,2,8,2,60,2,61, 2,62,2,63,2,64,2,65,2,66,2,67,2,68,2,69,2,70,2,71,40, 52,106,16,5,93,69,99,97,115,101,45,116,101,115,116,72,89,162,34,35,51, @@ -2687,7 +2690,7 @@ 11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196,27,249,22, 67,196,195,251,80,158,45,40,20,15,159,45,37,43,21,94,3,1,4,103,55, 48,48,77,3,1,4,103,54,57,57,78,248,22,58,197,248,22,59,197,250,22, -252,46,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,79,197,34,20, +252,47,2,11,6,10,10,98,97,100,32,115,121,110,116,97,120,79,197,34,20, 99,159,34,16,9,30,80,65,35,37,115,116,120,81,69,115,116,120,45,112,97, 105,114,63,82,11,30,83,2,81,67,99,111,110,115,47,35,102,84,1,30,85, 2,81,67,115,116,120,45,99,97,114,86,5,30,87,2,81,67,115,116,120,45, @@ -2699,15 +2702,15 @@ 62,108,105,115,116,99,4,16,4,18,98,64,104,101,114,101,100,40,98,38,10, 34,11,95,159,2,18,9,11,159,68,35,37,100,101,102,105,110,101,101,9,11, 159,74,35,37,115,109,97,108,108,45,115,99,104,101,109,101,102,9,11,16,78, -2,33,2,2,2,35,2,2,2,41,2,2,2,49,2,2,2,66,2,2,2, -63,2,2,2,45,2,2,2,39,2,2,2,68,2,2,2,60,2,2,2,43, -2,2,2,61,2,2,2,6,2,2,67,112,114,111,109,105,115,101,103,2,2, -2,53,2,2,1,22,98,114,101,97,107,45,112,97,114,97,109,101,116,101,114, -105,122,97,116,105,111,110,104,2,2,2,12,2,2,2,10,2,2,2,72,2, -2,2,62,2,2,2,8,2,2,2,14,2,2,2,57,2,2,2,16,2,2, -2,55,2,2,2,29,2,2,2,25,2,2,2,64,2,2,2,4,2,2,2, -65,2,2,2,67,2,2,2,27,2,2,2,37,2,2,2,69,2,2,2,70, -2,2,2,59,2,2,2,71,2,2,2,31,2,2,2,23,2,2,98,37,10, +2,33,2,2,2,61,2,2,1,22,98,114,101,97,107,45,112,97,114,97,109, +101,116,101,114,105,122,97,116,105,111,110,103,2,2,2,49,2,2,2,23,2, +2,2,70,2,2,2,64,2,2,2,39,2,2,2,43,2,2,2,41,2,2, +2,65,2,2,2,68,2,2,2,37,2,2,2,25,2,2,2,71,2,2,2, +45,2,2,2,35,2,2,2,12,2,2,2,10,2,2,2,60,2,2,2,57, +2,2,2,4,2,2,2,6,2,2,2,29,2,2,2,69,2,2,2,62,2, +2,2,53,2,2,2,63,2,2,2,27,2,2,67,112,114,111,109,105,115,101, +104,2,2,2,66,2,2,2,59,2,2,2,14,2,2,2,31,2,2,2,67, +2,2,2,72,2,2,2,55,2,2,2,8,2,2,2,16,2,2,98,37,10, 35,11,95,159,67,35,37,113,113,115,116,120,105,9,11,159,76,35,37,115,116, 120,99,97,115,101,45,115,99,104,101,109,101,106,9,11,159,2,81,9,11,16, 0,96,36,8,254,1,11,16,0,16,4,35,11,61,120,107,3,1,7,101,110, @@ -2721,7 +2724,7 @@ 57,120,3,1,4,103,54,57,48,121,3,1,4,103,54,57,49,122,3,1,7, 101,110,118,51,56,51,55,123,2,123,2,123,16,6,44,11,2,114,2,115,3, 1,7,101,110,118,51,56,51,56,124,2,124,158,2,77,46,158,95,10,2,117, -2,78,46,46,11,16,5,93,2,64,89,162,34,35,8,27,9,223,0,27,249, +2,78,46,46,11,16,5,93,2,68,89,162,34,35,8,27,9,223,0,27,249, 22,216,20,15,159,37,34,46,196,27,28,248,80,158,37,34,194,249,80,158,38, 35,248,80,158,39,36,196,27,248,80,158,40,37,197,28,248,80,158,40,34,193, 249,80,158,41,38,248,80,158,42,36,195,248,80,158,42,39,248,80,158,43,37, @@ -2736,9 +2739,9 @@ 27,248,80,158,51,37,196,28,248,80,158,51,42,193,248,80,158,51,43,193,11, 11,11,11,248,80,158,46,39,248,80,158,47,37,196,11,11,11,28,192,27,248, 22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22,94,197,249,80,158, -43,44,202,27,250,22,67,199,198,200,252,80,158,49,40,20,15,159,49,37,46, +43,44,202,27,250,22,67,198,200,199,252,80,158,49,40,20,15,159,49,37,46, 21,95,3,1,4,103,55,51,52,126,3,1,4,103,55,51,51,127,3,1,4, -103,55,51,50,128,248,22,86,198,248,22,58,198,248,22,84,198,27,28,248,80, +103,55,51,50,128,248,22,84,198,248,22,86,198,248,22,58,198,27,28,248,80, 158,39,34,196,249,80,158,40,35,248,80,158,41,36,198,27,248,80,158,42,37, 199,28,248,80,158,42,34,193,249,80,158,43,35,248,80,158,44,36,195,27,248, 80,158,45,37,196,28,248,80,158,45,34,193,249,80,158,46,38,27,248,80,158, @@ -2748,11 +2751,11 @@ 195,27,248,80,158,54,37,196,28,248,80,158,54,42,193,248,80,158,54,43,193, 11,11,11,248,80,158,47,39,248,80,158,48,37,196,11,11,11,28,192,27,248, 22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22,96,197,27,248,22, -95,198,249,80,158,45,44,204,27,251,22,67,201,202,200,199,250,80,158,49,45, +95,198,249,80,158,45,44,204,27,251,22,67,201,200,202,199,250,80,158,49,45, 89,162,34,34,43,9,224,15,3,253,80,158,41,40,20,15,159,41,38,46,21, 96,3,1,4,103,55,51,54,129,3,1,4,103,55,51,53,130,3,1,4,103, -55,51,56,131,3,1,4,103,55,51,55,132,248,22,84,199,248,22,58,199,248, -22,93,199,248,22,94,199,21,95,62,105,102,133,95,2,72,61,118,134,94,2, +55,51,56,131,3,1,4,103,55,51,55,132,248,22,93,199,248,22,58,199,248, +22,84,199,248,22,94,199,21,95,62,105,102,133,95,2,72,61,118,134,94,2, 115,63,46,46,46,135,96,2,0,62,101,49,136,62,101,50,137,2,135,20,15, 159,49,39,46,27,28,248,80,158,40,34,197,249,80,158,41,35,248,80,158,42, 36,199,27,248,80,158,43,37,200,28,248,80,158,43,34,193,249,80,158,44,35, @@ -2766,14 +2769,14 @@ 158,52,37,196,28,248,80,158,52,42,193,248,80,158,52,43,193,11,11,11,11, 11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22, 96,197,27,249,22,76,199,38,27,249,22,76,200,39,27,249,22,75,201,40,249, -80,158,48,44,23,15,27,253,22,67,205,202,206,201,204,203,250,80,158,52,45, +80,158,48,44,23,15,27,253,22,67,205,206,204,203,201,202,250,80,158,52,45, 89,162,34,34,46,9,224,18,3,26,8,80,158,43,40,20,15,159,43,40,46, 21,98,3,1,4,103,55,51,57,138,3,1,4,103,55,52,48,139,3,1,4, 103,55,52,50,140,3,1,4,103,55,52,49,141,3,1,4,103,55,52,52,142, -3,1,4,103,55,52,51,143,248,22,93,201,248,22,58,201,249,22,76,202,38, -249,22,75,202,39,248,22,84,201,248,22,96,201,21,95,63,108,101,116,144,93, +3,1,4,103,55,52,51,143,248,22,84,201,248,22,58,201,248,22,93,201,248, +22,96,201,249,22,75,202,39,249,22,76,202,38,21,95,63,108,101,116,144,93, 94,2,107,2,134,96,2,133,95,2,72,2,107,94,2,115,2,135,96,2,0, -2,136,2,137,2,135,97,2,64,2,107,62,99,49,145,62,99,50,146,2,135, +2,136,2,137,2,135,97,2,68,2,107,62,99,49,145,62,99,50,146,2,135, 20,15,159,52,41,46,27,28,248,80,158,41,34,198,249,80,158,42,35,248,80, 158,43,36,200,27,248,80,158,44,37,201,28,248,80,158,44,34,193,27,28,248, 22,213,194,193,201,249,80,158,46,35,248,80,158,47,36,196,27,248,80,158,48, @@ -2784,7 +2787,7 @@ 42,193,248,22,65,248,80,158,59,43,194,11,11,11,27,248,80,158,52,37,197, 250,22,216,198,195,198,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195, 27,248,22,93,196,27,248,22,96,197,27,249,22,76,199,38,27,249,22,75,200, -39,251,22,252,46,2,11,6,33,33,98,97,100,32,115,121,110,116,97,120,32, +39,251,22,252,47,2,11,6,33,33,98,97,100,32,115,121,110,116,97,120,32, 40,110,111,116,32,97,32,100,97,116,117,109,32,115,101,113,117,101,110,99,101, 41,147,23,17,199,27,28,248,80,158,42,34,199,249,80,158,43,35,248,80,158, 44,36,201,27,248,80,158,45,37,202,28,248,80,158,45,34,193,27,28,248,22, @@ -2792,15 +2795,15 @@ 197,28,248,80,158,49,34,193,27,28,248,22,213,194,193,196,249,80,158,51,35, 248,80,158,52,36,196,27,248,80,158,53,37,197,250,22,216,198,195,198,11,11, 11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22, -94,197,251,22,252,46,2,11,6,52,52,98,97,100,32,115,121,110,116,97,120, +94,197,251,22,252,47,2,11,6,52,52,98,97,100,32,115,121,110,116,97,120, 32,40,109,105,115,115,105,110,103,32,101,120,112,114,101,115,115,105,111,110,32, 97,102,116,101,114,32,100,97,116,117,109,32,115,101,113,117,101,110,99,101,41, 148,23,16,197,27,28,248,80,158,43,34,200,249,80,158,44,35,248,80,158,45, 36,202,27,248,80,158,46,37,203,250,22,216,205,195,205,11,28,192,27,248,22, -58,194,27,248,22,59,195,28,248,22,63,248,22,217,194,250,22,252,46,2,11, -2,79,204,250,22,252,46,2,11,6,31,31,98,97,100,32,115,121,110,116,97, +58,194,27,248,22,59,195,28,248,22,63,248,22,217,194,250,22,252,47,2,11, +2,79,204,250,22,252,47,2,11,6,31,31,98,97,100,32,115,121,110,116,97, 120,32,40,105,108,108,101,103,97,108,32,117,115,101,32,111,102,32,96,46,39, -41,149,206,250,22,252,46,2,11,2,79,202,34,20,99,159,34,16,12,2,80, +41,149,206,250,22,252,47,2,11,2,79,202,34,20,99,159,34,16,12,2,80, 2,83,2,85,2,87,2,89,2,91,2,93,30,150,2,81,71,105,100,101,110, 116,105,102,105,101,114,63,151,2,2,96,2,98,30,152,68,35,37,115,116,120, 108,111,99,153,68,114,101,108,111,99,97,116,101,154,0,30,155,2,94,1,20, @@ -2831,10 +2834,10 @@ 2,186,2,186,2,186,16,16,8,27,11,2,114,2,134,2,115,2,136,2,137, 2,145,2,146,3,1,7,101,110,118,51,57,49,53,187,2,187,2,187,2,187, 2,187,2,187,2,187,158,94,10,94,2,107,2,138,8,29,158,97,10,2,133, -95,2,72,2,107,2,139,159,2,0,2,140,2,141,160,2,64,2,107,2,142, +95,2,72,2,107,2,139,159,2,0,2,140,2,141,160,2,68,2,107,2,142, 2,143,8,29,8,29,18,16,2,96,2,135,8,31,93,8,252,224,12,16,4, 8,30,11,2,177,3,1,7,101,110,118,51,57,51,49,188,95,9,8,252,224, -12,2,94,11,16,5,93,2,63,87,95,83,159,34,93,80,159,34,8,33,35, +12,2,94,11,16,5,93,2,67,87,95,83,159,34,93,80,159,34,8,33,35, 89,162,35,35,41,9,223,0,251,80,158,38,47,20,15,159,38,46,49,21,94, 3,1,4,103,55,54,54,189,3,1,4,103,55,54,53,190,248,22,58,198,248, 22,84,198,83,159,34,93,80,159,34,8,32,35,89,162,35,35,41,9,223,0, @@ -2859,34 +2862,34 @@ 89,162,34,36,45,9,224,15,16,27,249,22,216,20,15,159,38,36,49,198,27, 248,80,158,38,43,194,28,192,196,27,28,248,80,158,39,34,195,249,80,158,40, 38,248,80,158,41,36,197,248,80,158,41,43,248,80,158,42,37,198,11,28,192, -192,250,22,252,46,2,11,6,19,19,98,97,100,32,118,97,114,105,97,98,108, +192,250,22,252,47,2,11,6,19,19,98,97,100,32,118,97,114,105,97,98,108, 101,32,115,121,110,116,97,120,193,198,248,22,223,249,80,158,52,44,20,15,159, 52,37,49,206,248,22,223,249,80,158,52,44,20,15,159,52,38,49,204,27,28, 248,80,158,46,39,194,248,80,158,46,41,194,11,28,192,27,249,22,216,20,15, 159,48,39,49,249,80,158,50,44,20,15,159,50,40,49,200,27,248,80,158,48, -43,194,28,192,249,80,158,49,45,23,16,27,252,22,67,206,204,202,23,16,23, -17,250,80,158,53,46,89,162,34,34,47,9,224,19,3,252,80,158,40,47,20, +43,194,28,192,249,80,158,49,45,23,16,27,252,22,67,202,206,23,17,204,23, +16,250,80,158,53,46,89,162,34,34,47,9,224,19,3,252,80,158,40,47,20, 15,159,40,41,49,21,95,3,1,4,103,55,54,52,194,3,1,4,103,55,54, 49,195,3,1,4,103,55,54,51,196,250,22,2,80,159,43,8,32,35,248,22, -95,201,248,22,96,201,248,22,58,198,249,22,71,248,22,84,200,250,80,158,45, -47,20,15,159,45,43,49,21,93,3,1,4,103,55,54,50,197,248,22,93,203, +93,201,248,22,95,201,248,22,84,198,249,22,71,248,22,96,200,250,80,158,45, +47,20,15,159,45,43,49,21,93,3,1,4,103,55,54,50,197,248,22,58,203, 21,96,2,144,66,100,111,108,111,111,112,198,94,94,63,118,97,114,199,64,105, 110,105,116,200,2,135,95,2,133,94,63,110,111,116,201,62,101,48,202,96,2, 0,61,99,203,2,135,95,2,198,64,115,116,101,112,204,2,135,20,15,159,53, 44,49,27,28,248,80,158,49,34,195,249,80,158,50,35,248,80,158,51,36,197, 27,248,80,158,52,37,198,28,248,80,158,52,39,193,248,80,158,52,41,193,11, 11,28,192,27,248,22,58,194,27,248,22,59,195,249,80,158,52,45,23,19,27, -254,22,67,23,17,23,15,23,21,23,22,203,23,19,202,250,80,158,56,46,89, +254,22,67,23,22,202,23,15,23,19,203,23,17,23,21,250,80,158,56,46,89, 162,34,34,49,9,224,22,3,254,80,158,42,47,20,15,159,42,45,49,21,97, 3,1,4,103,55,55,50,205,3,1,4,103,55,55,49,206,3,1,4,103,55, 54,56,207,3,1,4,103,55,54,55,208,3,1,4,103,55,55,48,209,250,22, -2,80,159,45,8,33,35,248,22,96,203,248,22,93,203,249,22,76,201,39,249, -22,76,201,38,249,22,75,201,40,249,22,71,248,22,58,202,250,80,158,47,47, -20,15,159,47,47,49,21,93,3,1,4,103,55,54,57,210,248,22,84,205,21, +2,80,159,45,8,33,35,248,22,58,203,249,22,75,204,40,248,22,96,200,249, +22,76,201,38,248,22,84,200,249,22,71,249,22,76,203,39,250,80,158,47,47, +20,15,159,47,47,49,21,93,3,1,4,103,55,54,57,210,248,22,93,205,21, 96,2,144,2,198,94,94,2,199,2,200,2,135,96,2,133,2,202,96,2,0, 2,136,2,137,2,135,96,2,0,2,203,2,135,95,2,198,2,204,2,135,20, -15,159,56,48,49,250,22,252,46,2,11,2,79,197,248,80,158,46,48,20,15, -159,46,49,49,250,22,252,46,2,11,2,79,196,34,20,99,159,36,16,15,2, +15,159,56,48,49,250,22,252,47,2,11,2,79,197,248,80,158,46,48,20,15, +159,46,49,49,250,22,252,47,2,11,2,79,196,34,20,99,159,36,16,15,2, 80,2,83,2,85,2,87,2,89,2,96,30,211,2,81,73,115,116,120,45,99, 104,101,99,107,47,101,115,99,212,7,2,98,30,213,2,81,70,115,116,120,45, 114,111,116,97,116,101,214,12,2,91,30,215,2,94,1,26,100,97,116,117,109, @@ -2909,16 +2912,16 @@ 8,42,18,158,97,10,2,144,2,198,2,194,95,2,133,94,2,201,2,195,158, 2,0,2,196,8,41,18,158,95,10,2,191,2,192,8,41,18,16,2,103,93, 158,159,10,2,198,2,197,8,41,8,50,98,8,49,10,34,11,95,159,2,18, -9,11,159,2,102,9,11,159,2,81,9,11,16,14,2,216,29,236,11,11,78, -112,97,116,116,101,114,110,45,115,117,98,115,116,105,116,117,116,101,237,2,236, -2,95,2,236,73,115,121,110,116,97,120,45,99,97,115,101,42,42,238,2,236, -2,156,2,236,66,115,121,110,116,97,120,239,2,236,75,115,117,98,115,116,105, -116,117,116,101,45,115,116,111,112,240,2,236,98,8,48,10,35,11,95,159,64, +9,11,159,2,102,9,11,159,2,81,9,11,16,14,66,115,121,110,116,97,120, +236,29,237,11,11,73,115,121,110,116,97,120,45,99,97,115,101,42,42,238,2, +237,2,156,2,237,78,112,97,116,116,101,114,110,45,115,117,98,115,116,105,116, +117,116,101,239,2,237,2,216,2,237,2,95,2,237,75,115,117,98,115,116,105, +116,117,116,101,45,115,116,111,112,240,2,237,98,8,48,10,35,11,95,159,64, 35,37,115,99,241,9,11,159,2,102,9,11,159,2,81,9,11,16,0,96,8, 47,8,254,1,11,16,0,16,4,8,46,11,2,107,3,1,6,101,110,118,52, 53,52,242,16,4,8,45,11,68,104,101,114,101,45,115,116,120,243,3,1,6, 101,110,118,52,53,54,244,16,4,8,44,11,2,243,2,244,13,16,4,35,2, -236,2,94,11,93,8,252,30,13,16,4,8,43,11,2,177,3,1,7,101,110, +237,2,94,11,93,8,252,30,13,16,4,8,43,11,2,177,3,1,7,101,110, 118,52,48,53,55,245,95,9,8,252,30,13,2,94,18,16,2,96,2,135,8, 52,93,8,252,30,13,16,4,8,51,11,2,177,2,245,95,9,8,252,30,13, 2,94,18,158,96,103,2,144,8,55,38,37,36,8,32,8,35,8,34,8,40, @@ -2928,7 +2931,7 @@ 97,10,2,133,2,206,159,2,0,2,207,2,208,158,2,0,2,209,8,55,8, 55,18,158,95,10,2,189,2,190,8,55,18,16,2,103,93,158,159,10,2,198, 2,210,8,55,8,57,8,49,8,48,8,47,8,46,8,45,8,44,13,16,4, -35,2,236,2,94,11,93,8,252,37,13,16,4,8,56,11,2,177,3,1,7, +35,2,237,2,94,11,93,8,252,37,13,16,4,8,56,11,2,177,3,1,7, 101,110,118,52,48,55,49,250,95,9,8,252,37,13,2,94,18,16,2,96,2, 135,8,59,93,8,252,37,13,16,4,8,58,11,2,177,2,250,95,9,8,252, 37,13,2,94,18,16,2,158,94,98,2,204,8,63,93,8,252,5,13,16,4, @@ -2936,22 +2939,22 @@ 52,48,50,51,252,252,0,16,4,8,61,11,3,1,4,103,55,53,53,252,253, 0,3,1,7,101,110,118,52,48,55,54,252,254,0,16,4,8,60,11,65,95, 101,108,115,101,252,255,0,3,1,7,101,110,118,52,48,55,55,252,0,1,158, -2,135,8,63,8,63,95,9,8,252,5,13,2,218,11,16,5,93,2,61,89, +2,135,8,63,8,63,95,9,8,252,5,13,2,218,11,16,5,93,2,62,89, 162,34,35,45,9,223,0,27,249,22,216,20,15,159,37,34,42,196,27,28,248, 80,158,37,34,194,249,80,158,38,35,248,80,158,39,36,196,27,248,80,158,40, 37,197,28,248,80,158,40,34,193,249,80,158,41,38,248,80,158,42,36,195,248, 80,158,42,39,248,80,158,43,37,196,11,11,28,192,27,248,22,58,194,27,248, 22,59,195,249,80,158,40,40,199,250,80,158,43,41,20,15,159,43,35,42,21, -93,3,1,4,103,55,55,53,252,1,1,197,250,22,252,46,2,11,2,79,196, +93,3,1,4,103,55,55,53,252,1,1,197,250,22,252,47,2,11,2,79,196, 34,20,99,159,34,16,8,2,80,2,83,2,85,2,87,2,89,2,91,2,152, 2,93,16,2,18,98,2,100,8,65,38,37,36,16,4,8,64,11,2,107,3, 1,7,101,110,118,52,48,56,49,252,2,1,18,158,94,100,2,6,8,68,38, 37,36,8,64,16,6,8,67,11,3,1,4,103,55,55,51,252,3,1,3,1, 4,103,55,55,52,252,4,1,3,1,7,101,110,118,52,48,56,54,252,5,1, -2,252,5,1,16,6,8,66,11,2,61,63,101,120,112,252,6,1,3,1,7, +2,252,5,1,16,6,8,66,11,2,62,63,101,120,112,252,6,1,3,1,7, 101,110,118,52,48,56,55,252,7,1,2,252,7,1,158,96,10,66,108,97,109, -98,100,97,252,8,1,9,2,252,1,1,8,68,8,68,11,16,5,93,2,103, -27,247,22,252,107,3,253,22,66,248,199,20,15,159,42,34,34,248,199,20,15, +98,100,97,252,8,1,9,2,252,1,1,8,68,8,68,11,16,5,93,2,104, +27,247,22,252,108,3,253,22,66,248,199,20,15,159,42,34,34,248,199,20,15, 159,42,35,34,248,199,20,15,159,42,36,34,248,22,66,248,200,20,15,159,43, 37,34,248,22,66,248,200,20,15,159,43,38,34,10,43,20,99,159,34,16,0, 16,5,18,97,2,4,8,69,38,37,36,18,16,2,158,2,6,8,69,8,70, @@ -2963,9 +2966,9 @@ 37,194,28,248,80,158,41,34,193,249,80,158,42,35,248,80,158,43,36,195,27, 248,80,158,44,37,196,28,248,80,158,44,39,193,248,80,158,44,40,193,11,11, 11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196,27, -249,22,67,195,196,251,80,158,44,41,20,15,159,44,35,49,21,94,3,1,4, -103,55,56,54,252,9,1,3,1,4,103,55,56,53,252,10,1,248,22,59,197, -248,22,58,197,27,28,248,80,158,38,34,195,249,80,158,39,35,248,80,158,40, +249,22,67,196,195,251,80,158,44,41,20,15,159,44,35,49,21,94,3,1,4, +103,55,56,54,252,9,1,3,1,4,103,55,56,53,252,10,1,248,22,58,197, +248,22,59,197,27,28,248,80,158,38,34,195,249,80,158,39,35,248,80,158,40, 36,197,27,248,80,158,41,37,198,28,248,80,158,41,34,193,249,80,158,42,42, 27,248,80,158,44,36,196,28,248,80,158,44,39,193,248,22,8,89,162,34,35, 41,9,224,10,1,27,249,22,2,89,162,34,35,46,9,224,4,5,249,80,158, @@ -2980,16 +2983,16 @@ 22,1,22,71,250,22,2,22,65,248,22,223,249,80,158,53,45,20,15,159,53, 37,49,206,248,22,223,249,80,158,53,45,20,15,159,53,38,49,205,27,28,248, 80,158,45,39,194,248,80,158,45,40,194,11,28,192,249,80,158,46,46,205,27, -250,22,67,201,198,200,250,80,158,50,47,89,162,34,34,42,9,224,16,3,252, +250,22,67,200,198,201,250,80,158,50,47,89,162,34,34,42,9,224,16,3,252, 80,158,40,41,20,15,159,40,39,49,21,95,3,1,4,103,55,57,48,252,11, 1,3,1,4,103,55,57,50,252,12,1,3,1,4,103,55,57,49,252,13,1, -248,22,84,198,248,22,58,198,248,22,86,198,21,96,1,22,119,105,116,104,45, +248,22,84,198,248,22,86,198,248,22,58,198,21,96,1,22,119,105,116,104,45, 99,111,110,116,105,110,117,97,116,105,111,110,45,109,97,114,107,252,14,1,2, 21,96,2,19,95,1,27,99,111,110,116,105,110,117,97,116,105,111,110,45,109, 97,114,107,45,115,101,116,45,102,105,114,115,116,252,15,1,11,2,21,63,112, 47,118,252,16,1,2,135,97,2,144,9,65,101,120,112,114,49,252,17,1,64, 101,120,112,114,252,18,1,2,135,20,15,159,50,40,49,248,80,158,45,48,20, -15,159,45,41,49,250,22,252,46,2,11,2,79,197,34,20,99,159,34,16,15, +15,159,45,41,49,250,22,252,47,2,11,2,79,197,34,20,99,159,34,16,15, 2,80,2,83,2,85,2,87,2,91,2,96,2,98,2,93,2,89,2,211,2, 213,2,215,2,152,2,155,2,217,16,8,18,98,2,100,8,75,38,37,36,16, 4,8,74,11,63,115,116,120,252,19,1,3,1,7,101,110,118,52,48,57,55, @@ -3020,16 +3023,16 @@ 4,103,55,56,56,252,41,1,3,1,7,101,110,118,52,49,53,49,252,42,1, 16,4,8,88,11,2,252,255,0,3,1,7,101,110,118,52,49,53,50,252,43, 1,158,2,135,8,91,8,91,95,9,8,252,94,13,2,218,11,16,5,93,2, -69,89,162,34,35,51,9,223,0,27,249,22,216,20,15,159,37,34,42,196,27, +66,89,162,34,35,51,9,223,0,27,249,22,216,20,15,159,37,34,42,196,27, 28,248,80,158,37,34,194,249,80,158,38,35,248,80,158,39,36,196,27,248,80, 158,40,37,197,28,248,80,158,40,34,193,249,80,158,41,35,248,80,158,42,36, 195,27,248,80,158,43,37,196,28,248,80,158,43,34,193,249,80,158,44,35,248, 80,158,45,36,195,27,248,80,158,46,37,196,28,248,80,158,46,38,193,248,80, 158,46,39,193,11,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27, -248,22,93,196,27,248,22,94,197,249,80,158,42,40,201,27,250,22,67,199,198, +248,22,93,196,27,248,22,94,197,249,80,158,42,40,201,27,250,22,67,198,199, 200,252,80,158,48,41,20,15,159,48,35,42,21,95,3,1,4,103,55,57,55, 252,44,1,3,1,4,103,55,57,57,252,45,1,3,1,4,103,55,57,56,252, -46,1,248,22,86,198,248,22,58,198,248,22,84,198,250,22,252,46,2,11,2, +46,1,248,22,86,198,248,22,84,198,248,22,58,198,250,22,252,47,2,11,2, 79,196,34,20,99,159,34,16,8,2,80,2,83,2,85,2,87,2,96,2,98, 2,152,2,93,16,2,18,98,2,100,8,93,38,37,36,16,4,8,92,11,2, 252,19,1,3,1,7,101,110,118,52,49,53,54,252,47,1,18,158,96,100,2, @@ -3042,13 +3045,13 @@ 252,54,1,2,252,54,1,158,2,47,8,96,158,95,10,76,109,97,107,101,45, 116,104,114,101,97,100,45,99,101,108,108,252,55,1,95,63,97,110,100,252,56, 1,2,252,44,1,10,8,96,158,96,10,2,0,93,2,51,160,2,144,9,2, -252,45,1,2,252,46,1,8,96,8,96,11,16,5,93,2,104,27,247,22,252, -107,3,253,22,66,248,199,20,15,159,42,34,34,248,199,20,15,159,42,35,34, +252,45,1,2,252,46,1,8,96,8,96,11,16,5,93,2,103,27,247,22,252, +108,3,253,22,66,248,199,20,15,159,42,34,34,248,199,20,15,159,42,35,34, 248,199,20,15,159,42,36,34,248,22,66,248,200,20,15,159,43,37,34,248,22, 66,248,200,20,15,159,43,38,34,10,43,20,99,159,34,16,0,16,5,18,16, 2,158,2,35,8,69,8,97,18,16,2,158,2,37,8,69,8,98,18,16,2, 158,2,39,8,69,8,99,18,16,2,158,2,41,8,69,8,100,18,16,2,158, -2,43,8,69,8,101,11,16,5,94,2,67,2,70,87,96,83,159,34,93,80, +2,43,8,69,8,101,11,16,5,94,2,63,2,69,87,96,83,159,34,93,80, 159,34,8,36,35,89,162,35,35,41,9,223,0,251,80,158,38,42,20,15,159, 38,47,50,21,94,3,1,4,103,56,50,53,252,57,1,3,1,4,103,56,50, 52,252,58,1,248,22,58,198,248,22,84,198,83,159,34,93,80,159,34,8,35, @@ -3064,9 +3067,9 @@ 194,27,248,80,158,42,37,194,28,248,80,158,42,34,193,249,80,158,43,35,248, 80,158,44,36,195,27,248,80,158,45,37,196,28,248,80,158,45,39,193,248,80, 158,45,40,193,11,11,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195, -27,248,22,86,196,249,80,158,42,41,201,27,249,22,67,197,198,251,80,158,47, +27,248,22,86,196,249,80,158,42,41,201,27,249,22,67,198,197,251,80,158,47, 42,20,15,159,47,35,50,21,94,3,1,4,103,56,49,48,252,64,1,3,1, -4,103,56,48,57,252,65,1,248,22,59,197,248,22,58,197,27,28,248,80,158, +4,103,56,48,57,252,65,1,248,22,58,197,248,22,59,197,27,28,248,80,158, 39,34,195,249,80,158,40,35,248,80,158,41,36,197,27,248,80,158,42,37,198, 28,248,80,158,42,34,193,249,80,158,43,43,27,248,80,158,45,36,196,28,248, 80,158,45,39,193,248,22,8,89,162,34,35,41,9,224,11,1,27,249,22,2, @@ -3088,15 +3091,15 @@ 248,80,158,47,39,195,248,80,158,47,40,195,11,28,192,27,28,248,80,158,48, 39,195,248,80,158,48,40,195,11,28,192,27,249,22,216,20,15,159,50,40,50, 28,23,15,20,15,159,50,41,50,20,15,159,50,42,50,249,80,158,50,41,23, -17,27,254,22,67,204,203,202,23,15,23,18,23,16,23,17,250,80,158,54,48, -89,162,34,34,52,9,224,20,3,254,80,158,42,42,20,15,159,42,43,50,21, +17,27,254,22,67,204,203,23,17,202,23,15,23,18,23,16,250,80,158,54,48, +89,162,34,34,51,9,224,20,3,254,80,158,42,42,20,15,159,42,43,50,21, 97,3,1,4,103,56,51,48,252,70,1,3,1,4,103,56,50,55,252,71,1, 3,1,4,103,56,50,54,252,72,1,3,1,4,103,56,50,57,252,73,1,3, 1,4,103,56,50,56,252,74,1,249,22,71,250,22,2,80,159,47,8,34,35, -248,22,58,205,249,22,76,206,38,249,22,71,250,22,2,80,159,49,8,35,35, -248,22,84,23,15,249,22,75,23,16,40,20,15,159,46,46,50,248,22,93,200, -250,22,2,80,159,45,8,36,35,248,22,58,203,248,22,84,203,249,22,76,201, -39,248,22,96,200,21,95,2,144,97,94,69,112,114,101,100,45,110,97,109,101, +248,22,58,205,249,22,76,206,39,249,22,71,250,22,2,80,159,49,8,35,35, +248,22,84,23,15,248,22,93,23,15,20,15,159,46,46,50,248,22,96,200,250, +22,2,80,159,45,8,36,35,248,22,58,203,248,22,84,203,249,22,75,201,40, +249,22,76,201,38,21,95,2,144,97,94,69,112,114,101,100,45,110,97,109,101, 252,75,1,64,112,114,101,100,252,76,1,2,135,94,72,104,97,110,100,108,101, 114,45,110,97,109,101,252,77,1,67,104,97,110,100,108,101,114,252,78,1,2, 135,94,78,104,97,110,100,108,101,114,45,112,114,111,109,112,116,45,107,101,121, @@ -3115,7 +3118,7 @@ 252,77,1,2,135,2,252,17,1,2,252,18,1,2,135,2,252,79,1,95,2, 252,8,1,93,65,116,104,117,110,107,252,89,1,93,2,252,89,1,20,15,159, 54,48,50,248,80,158,48,49,20,15,159,48,49,50,248,80,158,47,49,20,15, -159,47,50,50,250,22,252,46,2,11,2,79,197,249,22,7,248,195,10,248,195, +159,47,50,50,250,22,252,47,2,11,2,79,197,249,22,7,248,195,10,248,195, 11,38,20,99,159,37,16,16,2,80,2,83,2,85,2,87,2,91,2,96,2, 98,2,152,2,93,2,89,2,211,2,213,30,252,90,1,2,218,1,20,103,101, 110,101,114,97,116,101,45,116,101,109,112,111,114,97,114,105,101,115,252,91,1, @@ -3153,7 +3156,7 @@ 2,252,89,1,93,2,252,89,1,8,117,18,158,95,10,2,252,61,1,2,252, 62,1,8,117,18,158,95,10,2,252,59,1,2,252,60,1,8,117,18,16,2, 103,93,158,95,10,2,252,79,1,93,2,252,80,1,8,117,8,121,8,49,8, -48,8,47,8,46,8,45,8,44,13,16,4,35,2,236,2,94,11,93,8,252, +48,8,47,8,46,8,45,8,44,13,16,4,35,2,237,2,94,11,93,8,252, 192,13,16,4,8,120,11,2,177,3,1,7,101,110,118,52,50,53,52,252,113, 1,95,9,8,252,192,13,2,94,18,158,96,10,2,252,88,1,2,252,57,1, 2,252,58,1,8,117,18,16,2,96,2,135,8,123,93,8,252,192,13,16,4, @@ -3169,7 +3172,7 @@ 8,129,11,3,1,4,103,56,49,51,252,120,1,3,1,7,101,110,118,52,50, 54,56,252,121,1,16,4,8,128,11,2,252,255,0,3,1,7,101,110,118,52, 50,54,57,252,122,1,158,2,135,8,131,8,131,95,9,8,252,167,13,2,218, -11,16,5,93,2,65,87,95,83,159,34,93,80,159,34,8,28,35,89,162,34, +11,16,5,93,2,64,87,95,83,159,34,93,80,159,34,8,28,35,89,162,34, 36,49,68,116,114,121,45,110,101,120,116,252,123,1,223,0,27,28,248,80,158, 36,34,195,249,80,158,37,35,248,80,158,38,36,197,27,248,80,158,39,37,198, 28,248,80,158,39,34,193,249,80,158,40,39,27,248,80,158,42,36,196,28,248, @@ -3178,9 +3181,9 @@ 158,44,38,248,80,158,45,37,196,11,11,11,28,192,27,248,22,58,194,27,248, 22,84,195,27,248,22,86,196,28,27,248,80,158,40,42,249,80,158,42,43,20, 15,159,42,36,50,197,87,94,249,22,3,89,162,34,35,41,9,224,7,9,28, -248,80,158,36,44,195,12,251,22,252,46,2,11,6,17,17,110,111,116,32,97, +248,80,158,36,44,195,12,251,22,252,47,2,11,6,17,17,110,111,116,32,97, 110,32,105,100,101,110,116,105,102,105,101,114,252,124,1,196,198,194,27,248,80, -158,41,45,194,28,192,251,22,252,46,2,11,6,20,20,100,117,112,108,105,99, +158,41,45,194,28,192,251,22,252,47,2,11,6,20,20,100,117,112,108,105,99, 97,116,101,32,105,100,101,110,116,105,102,105,101,114,252,125,1,204,196,12,27, 249,22,216,20,15,159,41,37,50,248,80,158,42,46,249,80,158,44,43,20,15, 159,44,38,50,199,27,28,248,80,158,41,41,194,248,80,158,41,42,194,11,28, @@ -3192,7 +3195,7 @@ 108,117,101,115,252,129,1,93,94,94,64,116,101,109,112,252,130,1,2,135,2, 252,18,1,95,64,115,101,116,33,252,131,1,62,105,100,252,132,1,2,252,130, 1,2,135,20,15,159,46,41,50,248,80,158,41,49,20,15,159,41,42,50,250, -22,252,46,2,11,2,79,200,250,22,252,46,2,11,2,79,197,83,159,34,93, +22,252,47,2,11,2,79,200,250,22,252,47,2,11,2,79,197,83,159,34,93, 80,159,34,8,27,35,89,162,35,35,41,9,223,0,251,80,158,38,40,20,15, 159,38,40,50,21,94,3,1,4,103,56,52,54,252,133,1,3,1,4,103,56, 52,53,252,134,1,248,22,58,198,248,22,84,198,89,162,34,35,49,9,223,0, @@ -3209,9 +3212,9 @@ 158,44,37,196,28,248,80,158,44,34,193,249,80,158,45,39,248,80,158,46,36, 195,248,80,158,46,38,248,80,158,47,37,196,11,11,11,28,192,27,248,22,58, 194,27,248,22,84,195,27,248,22,86,196,28,248,80,158,41,44,194,27,249,22, -67,196,195,251,80,158,45,40,20,15,159,45,43,50,21,94,3,1,4,103,56, -52,57,252,136,1,3,1,4,103,56,52,56,252,137,1,248,22,58,197,248,22, -59,197,249,80,159,42,8,28,35,199,201,249,80,159,39,8,28,35,196,198,34, +67,195,196,251,80,158,45,40,20,15,159,45,43,50,21,94,3,1,4,103,56, +52,57,252,136,1,3,1,4,103,56,52,56,252,137,1,248,22,59,197,248,22, +58,197,249,80,159,42,8,28,35,199,201,249,80,159,39,8,28,35,196,198,34, 20,99,159,36,16,16,2,80,2,83,2,85,2,87,2,91,2,89,2,93,2, 96,2,98,2,215,2,150,30,252,138,1,2,106,1,26,99,104,101,99,107,45, 100,117,112,108,105,99,97,116,101,45,105,100,101,110,116,105,102,105,101,114,252, @@ -3228,226 +3231,229 @@ 50,57,54,252,149,1,2,252,149,1,2,252,149,1,16,8,8,137,11,2,114, 2,252,132,1,2,252,18,1,3,1,7,101,110,118,52,50,57,55,252,150,1, 2,252,150,1,2,252,150,1,18,16,2,158,2,100,8,139,8,140,18,16,2, -158,2,233,8,139,8,141,18,158,161,36,102,2,252,129,1,8,144,38,37,36, -8,132,8,138,8,137,16,4,8,143,11,3,1,4,103,56,52,50,252,151,1, -3,1,7,101,110,118,52,51,49,51,252,152,1,16,4,8,142,11,2,252,130, -1,3,1,7,101,110,118,52,51,49,52,252,153,1,158,94,10,94,2,252,126, -1,2,252,127,1,8,144,2,252,128,1,8,144,8,144,18,158,96,10,2,252, -131,1,2,252,133,1,2,252,134,1,8,144,18,16,2,96,2,135,8,146,93, -8,252,244,13,16,4,8,145,11,2,177,3,1,7,101,110,118,52,51,49,56, -252,154,1,95,9,8,252,244,13,2,94,18,16,2,158,94,98,2,252,130,1, -8,150,93,8,252,236,13,16,4,8,149,11,3,1,8,119,115,116,109,112,56, -52,48,252,155,1,3,1,7,101,110,118,52,51,48,56,252,156,1,16,4,8, -148,11,3,1,4,103,56,52,49,252,157,1,3,1,7,101,110,118,52,51,50, -51,252,158,1,16,4,8,147,11,2,252,255,0,3,1,7,101,110,118,52,51, -50,52,252,159,1,158,2,135,8,150,8,150,95,9,8,252,236,13,2,218,18, -158,95,100,2,252,131,1,8,153,38,37,36,8,132,16,8,8,152,11,3,1, -4,103,56,51,52,252,160,1,3,1,4,103,56,51,53,252,161,1,3,1,4, -103,56,51,54,252,162,1,3,1,7,101,110,118,52,51,51,50,252,163,1,2, -252,163,1,2,252,163,1,16,8,8,151,11,2,114,2,252,132,1,2,252,18, -1,3,1,7,101,110,118,52,51,51,51,252,164,1,2,252,164,1,2,252,164, -1,158,2,252,136,1,8,153,158,2,252,137,1,8,153,8,153,11,16,5,93, -2,66,89,162,34,35,51,9,223,0,27,249,22,216,20,15,159,37,34,42,196, -27,28,248,80,158,37,34,194,249,80,158,38,35,248,80,158,39,36,196,27,248, -80,158,40,37,197,28,248,80,158,40,34,193,249,80,158,41,35,248,80,158,42, -36,195,27,248,80,158,43,37,196,28,248,80,158,43,34,193,249,80,158,44,35, -248,80,158,45,36,195,27,248,80,158,46,37,196,28,248,80,158,46,38,193,248, -80,158,46,39,193,11,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195, -27,248,22,93,196,27,248,22,94,197,249,80,158,42,40,201,27,250,22,67,200, -199,198,252,80,158,48,41,20,15,159,48,35,42,21,95,3,1,4,103,56,53, -52,252,165,1,3,1,4,103,56,53,54,252,166,1,3,1,4,103,56,53,53, -252,167,1,248,22,58,198,248,22,84,198,248,22,86,198,250,22,252,46,2,11, -2,79,196,34,20,99,159,34,16,8,2,80,2,83,2,85,2,87,2,96,2, -98,2,152,2,93,16,2,18,98,2,100,8,155,38,37,36,16,4,8,154,11, -2,252,19,1,3,1,7,101,110,118,52,51,52,50,252,168,1,18,158,94,100, -67,99,97,108,108,47,99,99,252,169,1,8,158,38,37,36,8,154,16,10,8, -157,11,3,1,4,103,56,53,48,252,170,1,3,1,4,103,56,53,49,252,171, -1,3,1,4,103,56,53,50,252,172,1,3,1,4,103,56,53,51,252,173,1, -3,1,7,101,110,118,52,51,52,57,252,174,1,2,252,174,1,2,252,174,1, -2,252,174,1,16,10,8,156,11,2,114,2,199,65,98,111,100,121,49,252,175, -1,64,98,111,100,121,252,176,1,3,1,7,101,110,118,52,51,53,48,252,177, -1,2,252,177,1,2,252,177,1,2,252,177,1,158,161,10,2,252,8,1,93, -2,252,165,1,2,252,166,1,2,252,167,1,8,158,8,158,11,16,5,93,2, -68,89,162,34,35,51,9,223,0,27,249,22,216,20,15,159,37,34,44,196,27, -28,248,80,158,37,34,194,249,80,158,38,35,248,80,158,39,36,196,27,248,80, -158,40,37,197,28,248,80,158,40,34,193,249,80,158,41,35,248,80,158,42,36, -195,27,248,80,158,43,37,196,28,248,80,158,43,34,193,249,80,158,44,38,27, -248,80,158,46,36,196,28,248,80,158,46,39,193,248,22,65,248,80,158,47,40, -194,11,27,248,80,158,46,37,196,28,248,80,158,46,34,193,249,80,158,47,35, -248,80,158,48,36,195,27,248,80,158,49,37,196,28,248,80,158,49,39,193,248, -80,158,49,40,193,11,11,11,11,11,28,192,27,248,22,58,194,27,248,22,84, -195,27,248,22,93,196,27,248,22,96,197,27,248,22,95,198,249,80,158,43,41, -202,27,251,22,67,201,202,200,199,250,80,158,47,42,89,162,34,34,43,9,224, -13,3,253,80,158,41,43,20,15,159,41,35,44,21,96,3,1,4,103,56,54, -51,252,178,1,3,1,4,103,56,54,50,252,179,1,3,1,4,103,56,54,53, -252,180,1,3,1,4,103,56,54,52,252,181,1,248,22,84,199,248,22,58,199, -248,22,93,199,248,22,94,199,21,98,2,144,9,95,73,100,101,102,105,110,101, -45,115,116,114,117,99,116,252,182,1,64,98,97,115,101,252,183,1,94,65,102, -105,101,108,100,252,184,1,2,135,2,252,175,1,2,252,176,1,2,135,20,15, -159,47,36,44,250,22,252,46,2,11,2,79,196,34,20,99,159,34,16,10,2, -80,2,83,2,85,2,87,2,89,2,96,2,98,2,152,2,155,2,93,16,3, -18,98,2,100,8,160,38,37,36,16,4,8,159,11,2,252,19,1,3,1,7, -101,110,118,52,51,54,50,252,185,1,18,158,163,38,100,2,144,8,163,38,37, -36,8,159,16,12,8,162,11,3,1,4,103,56,53,55,252,186,1,3,1,4, -103,56,53,56,252,187,1,3,1,4,103,56,53,57,252,188,1,3,1,4,103, -56,54,48,252,189,1,3,1,4,103,56,54,49,252,190,1,3,1,7,101,110, -118,52,51,55,49,252,191,1,2,252,191,1,2,252,191,1,2,252,191,1,2, -252,191,1,16,12,8,161,11,2,114,2,252,183,1,2,252,184,1,2,252,175, -1,2,252,176,1,3,1,7,101,110,118,52,51,55,50,252,192,1,2,252,192, -1,2,252,192,1,2,252,192,1,2,252,192,1,158,9,8,163,158,96,10,2, -252,182,1,2,252,178,1,2,252,179,1,8,163,158,2,252,180,1,8,163,2, -252,181,1,8,163,8,163,18,16,2,96,2,135,8,165,93,8,252,27,14,16, -4,8,164,11,2,177,3,1,7,101,110,118,52,51,56,52,252,193,1,95,9, -8,252,27,14,2,94,11,16,5,93,2,71,87,95,83,159,34,93,80,159,34, -8,27,35,89,162,35,35,41,9,223,0,251,80,158,38,42,20,15,159,38,40, -50,21,94,3,1,4,103,56,56,49,252,194,1,3,1,4,103,56,56,50,252, -195,1,248,22,58,198,248,22,93,198,83,159,34,93,80,159,34,8,26,35,89, -162,35,35,41,9,223,0,251,80,158,38,42,20,15,159,38,39,50,21,94,3, -1,4,103,56,56,48,252,196,1,3,1,4,103,56,55,57,252,197,1,248,22, -58,198,248,22,84,198,89,162,34,35,54,9,223,0,27,249,22,216,20,15,159, -37,34,50,196,27,28,248,80,158,37,34,194,249,80,158,38,35,248,80,158,39, -36,196,27,248,80,158,40,37,197,28,248,80,158,40,34,193,28,248,80,158,40, -38,248,80,158,41,36,194,27,248,80,158,41,37,194,28,248,80,158,41,34,193, -249,80,158,42,35,248,80,158,43,36,195,27,248,80,158,44,37,196,28,248,80, -158,44,39,193,248,80,158,44,40,193,11,11,11,11,11,28,192,27,248,22,58, -194,27,248,22,84,195,27,248,22,86,196,249,80,158,41,41,200,27,249,22,67, -198,197,251,80,158,46,42,20,15,159,46,35,50,21,94,3,1,4,103,56,55, -53,252,198,1,3,1,4,103,56,55,52,252,199,1,248,22,58,197,248,22,59, -197,27,28,248,80,158,38,34,195,249,80,158,39,35,248,80,158,40,36,197,27, -248,80,158,41,37,198,28,248,80,158,41,34,193,249,80,158,42,43,27,248,80, -158,44,36,196,28,248,80,158,44,39,193,248,22,8,89,162,34,35,41,9,224, -10,1,27,249,22,2,89,162,34,35,46,9,224,4,5,249,80,158,37,44,28, -248,80,158,38,34,197,249,80,158,39,35,248,80,158,40,36,199,27,248,80,158, -41,37,200,28,248,80,158,41,34,193,249,80,158,42,35,248,80,158,43,36,195, -248,80,158,43,38,248,80,158,44,37,196,11,11,194,248,80,158,39,40,196,28, -248,22,63,193,21,94,9,9,248,80,158,37,45,193,11,27,248,80,158,44,37, -196,28,248,80,158,44,34,193,249,80,158,45,35,248,80,158,46,36,195,27,248, -80,158,47,37,196,28,248,80,158,47,39,193,248,80,158,47,40,193,11,11,11, -11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22, -96,197,27,248,22,95,198,27,249,22,216,20,15,159,45,36,50,248,80,158,46, -46,249,80,158,48,47,20,15,159,48,37,50,201,27,28,248,80,158,45,39,194, -248,80,158,45,40,194,11,28,192,249,80,158,46,41,205,27,252,22,67,205,204, -203,200,202,250,80,158,50,48,89,162,34,34,48,9,224,16,3,253,80,158,41, -42,20,15,159,41,38,50,21,96,3,1,4,103,56,56,56,252,200,1,3,1, -4,103,56,56,53,252,201,1,3,1,4,103,56,56,55,252,202,1,3,1,4, -103,56,56,54,252,203,1,250,22,2,80,159,44,8,26,35,248,22,96,202,248, -22,84,202,252,22,2,80,159,46,8,27,35,248,22,96,204,248,22,96,204,248, -22,58,204,248,22,58,204,248,22,93,199,248,22,95,199,21,95,2,144,94,94, -63,116,109,112,252,204,1,2,252,33,1,2,135,95,2,144,93,94,64,115,119, -97,112,252,205,1,96,2,252,8,1,9,96,2,144,93,94,2,231,2,252,204, -1,95,2,252,131,1,2,252,204,1,64,110,97,109,101,252,206,1,95,2,252, -131,1,2,252,206,1,2,231,2,135,96,72,100,121,110,97,109,105,99,45,119, -105,110,100,252,207,1,2,252,205,1,97,2,252,8,1,9,2,252,175,1,2, -252,176,1,2,135,2,252,205,1,20,15,159,50,41,50,248,80,158,45,49,20, -15,159,45,42,50,250,22,252,46,2,11,2,79,197,34,20,99,159,36,16,16, -2,80,2,83,2,85,2,87,2,91,2,96,2,98,2,152,2,93,2,89,2, -211,2,213,2,252,90,1,2,215,2,155,2,217,16,9,18,98,2,100,8,167, -38,37,36,16,4,8,166,11,2,252,19,1,3,1,7,101,110,118,52,51,56, -55,252,208,1,18,158,162,37,100,2,144,8,170,38,37,36,8,166,16,8,8, -169,11,3,1,4,103,56,55,49,252,209,1,3,1,4,103,56,55,50,252,210, -1,3,1,4,103,56,55,51,252,211,1,3,1,7,101,110,118,52,51,57,52, -252,212,1,2,252,212,1,2,252,212,1,16,8,8,168,11,2,114,2,252,175, -1,2,252,176,1,3,1,7,101,110,118,52,51,57,53,252,213,1,2,252,213, -1,2,252,213,1,158,9,8,170,158,2,252,198,1,8,170,2,252,199,1,8, -170,8,170,18,100,2,100,8,173,38,37,36,8,166,16,12,8,172,11,3,1, -4,103,56,54,54,252,214,1,3,1,4,103,56,54,55,252,215,1,3,1,4, -103,56,54,56,252,216,1,3,1,4,103,56,54,57,252,217,1,3,1,4,103, -56,55,48,252,218,1,3,1,7,101,110,118,52,52,49,52,252,219,1,2,252, -219,1,2,252,219,1,2,252,219,1,2,252,219,1,16,12,8,171,11,2,114, -2,252,206,1,2,252,33,1,2,252,175,1,2,252,176,1,3,1,7,101,110, -118,52,52,49,53,252,220,1,2,252,220,1,2,252,220,1,2,252,220,1,2, -252,220,1,18,16,2,158,2,233,8,173,8,174,18,158,95,102,2,144,8,177, -38,37,36,8,166,8,172,8,171,16,4,8,176,11,3,1,4,103,56,55,56, -252,221,1,3,1,7,101,110,118,52,52,51,50,252,222,1,16,4,8,175,11, -2,252,204,1,3,1,7,101,110,118,52,52,51,51,252,223,1,158,2,252,200, -1,8,177,158,96,10,2,144,93,94,2,252,205,1,159,2,252,8,1,9,2, -252,201,1,96,2,252,207,1,2,252,205,1,160,2,252,8,1,9,2,252,202, -1,2,252,203,1,2,252,205,1,8,177,8,177,18,158,95,10,2,252,196,1, -2,252,197,1,8,177,18,158,97,10,2,144,93,94,2,231,2,252,194,1,95, -2,252,131,1,2,252,194,1,2,252,195,1,95,2,252,131,1,2,252,195,1, -2,231,8,177,18,16,2,96,2,135,8,179,93,8,252,63,14,16,4,8,178, -11,2,177,3,1,7,101,110,118,52,52,51,55,252,224,1,95,9,8,252,63, -14,2,94,18,16,2,158,94,98,2,252,204,1,8,183,93,8,252,55,14,16, -4,8,182,11,3,1,8,119,115,116,109,112,56,55,54,252,225,1,3,1,7, -101,110,118,52,52,50,55,252,226,1,16,4,8,181,11,3,1,4,103,56,55, -55,252,227,1,3,1,7,101,110,118,52,52,52,52,252,228,1,16,4,8,180, -11,2,252,255,0,3,1,7,101,110,118,52,52,52,53,252,229,1,158,2,135, -8,183,8,183,95,9,8,252,55,14,2,218,11,16,5,93,2,62,89,162,34, -35,49,9,223,0,27,249,22,216,20,15,159,37,34,42,196,27,28,248,80,158, -37,34,194,249,80,158,38,35,248,80,158,39,36,196,27,248,80,158,40,37,197, -28,248,80,158,40,34,193,249,80,158,41,35,248,80,158,42,36,195,27,248,80, -158,43,37,196,28,248,80,158,43,38,193,248,80,158,43,39,193,11,11,11,28, -192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196,249,80,158,41,40, -200,27,249,22,67,197,198,251,80,158,46,41,20,15,159,46,35,42,21,94,3, -1,4,103,56,57,51,252,230,1,3,1,4,103,56,57,50,252,231,1,248,22, -59,197,248,22,58,197,250,22,252,46,2,11,2,79,196,34,20,99,159,34,16, -8,2,80,2,83,2,85,2,87,2,96,2,98,2,152,2,93,16,2,18,98, -2,100,8,185,38,37,36,16,4,8,184,11,2,252,19,1,3,1,7,101,110, -118,52,52,52,57,252,232,1,18,158,96,100,2,252,129,1,8,188,38,37,36, -8,184,16,8,8,187,11,3,1,4,103,56,56,57,252,233,1,3,1,4,103, -56,57,48,252,234,1,3,1,4,103,56,57,49,252,235,1,3,1,7,101,110, -118,52,52,53,53,252,236,1,2,252,236,1,2,252,236,1,16,8,8,186,11, -2,114,2,252,17,1,2,252,18,1,3,1,7,101,110,118,52,52,53,54,252, -237,1,2,252,237,1,2,252,237,1,158,94,10,94,96,2,134,63,99,112,117, -252,238,1,64,117,115,101,114,252,239,1,62,103,99,252,240,1,95,70,116,105, -109,101,45,97,112,112,108,121,252,241,1,160,2,252,8,1,9,2,252,230,1, -2,252,231,1,64,110,117,108,108,252,242,1,8,188,158,98,10,66,112,114,105, -110,116,102,252,243,1,6,40,40,99,112,117,32,116,105,109,101,58,32,126,115, -32,114,101,97,108,32,116,105,109,101,58,32,126,115,32,103,99,32,116,105,109, -101,58,32,126,115,126,110,252,244,1,2,252,238,1,2,252,239,1,2,252,240, -1,8,188,158,96,10,65,97,112,112,108,121,252,245,1,66,118,97,108,117,101, -115,252,246,1,2,134,8,188,8,188,11,104,83,159,34,97,80,159,34,34,35, -80,159,34,35,35,80,159,34,36,35,80,159,34,37,35,80,159,34,38,35,27, -247,22,252,121,2,87,94,28,192,28,248,22,252,120,2,193,12,250,22,252,47, -2,2,252,182,1,6,15,15,105,110,115,112,101,99,116,111,114,32,111,114,32, -35,102,252,247,1,195,12,91,159,39,11,90,161,39,34,11,254,22,252,98,2, -2,103,11,35,34,11,9,204,252,22,7,197,198,199,250,22,252,100,2,203,34, -61,112,252,248,1,250,22,252,101,2,204,34,2,252,248,1,83,159,34,93,80, -159,34,39,35,89,162,34,35,41,2,14,223,0,87,94,28,248,80,158,35,36, -194,12,250,22,252,47,2,2,14,6,7,7,112,114,111,109,105,115,101,252,249, -1,196,27,248,80,158,36,37,195,28,248,22,0,193,27,249,22,6,195,22,65, -87,94,28,248,22,0,248,80,158,38,37,197,249,80,158,38,38,197,194,12,249, -22,1,22,7,248,80,158,39,37,198,249,22,1,22,7,194,83,159,34,93,80, -159,34,40,35,89,162,34,34,38,2,16,223,0,248,80,158,35,41,249,22,25, -11,80,158,37,42,83,159,34,93,80,159,34,43,35,89,162,34,36,42,2,23, -223,0,87,95,28,248,22,252,230,2,194,12,252,22,252,47,2,2,23,6,16, -16,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,252,250,1,34, -198,199,28,28,248,22,0,195,249,22,40,196,34,11,12,252,22,252,47,2,2, -23,6,19,19,112,114,111,99,101,100,117,114,101,32,40,97,114,105,116,121,32, -48,41,252,251,1,35,198,199,20,14,159,80,158,34,42,193,247,194,83,159,34, -97,80,159,34,44,35,80,159,34,45,35,80,159,34,46,35,80,159,34,47,35, -80,159,34,48,35,252,22,252,98,2,2,104,11,35,34,11,83,159,34,97,80, -159,34,49,35,80,159,34,50,35,80,159,34,51,35,80,159,34,52,35,80,159, -34,53,35,27,247,22,252,121,2,87,94,28,192,28,248,22,252,16,2,248,22, -252,120,2,194,250,22,252,47,2,2,252,182,1,2,252,247,1,195,12,12,91, -159,39,11,90,161,39,34,11,254,22,252,98,2,2,104,11,35,34,11,9,204, -252,22,7,197,198,199,250,22,252,100,2,203,34,64,99,101,108,108,252,252,1, -250,22,252,101,2,204,34,2,252,252,1,83,159,34,93,80,159,34,54,35,89, -162,34,34,38,2,45,223,0,248,80,158,35,45,249,22,25,11,80,158,37,55, -83,159,34,93,80,159,34,56,35,89,162,38,36,42,2,49,223,0,87,95,28, -248,80,158,35,46,194,12,252,22,252,47,2,2,49,6,22,22,98,114,101,97, -107,32,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,252,253,1, -34,198,199,28,28,248,22,0,195,249,22,40,196,34,11,12,252,22,252,47,2, -2,23,6,19,19,112,114,111,99,101,100,117,114,101,32,40,97,114,105,116,121, -32,48,41,252,254,1,35,198,199,83,158,38,20,94,94,20,14,159,80,158,34, -55,249,80,158,36,47,195,34,87,94,247,80,158,34,57,247,194,247,80,158,34, -57,83,159,34,93,80,159,34,58,35,89,162,34,37,42,2,53,223,0,28,248, -22,63,196,248,22,252,194,2,194,28,248,248,22,83,197,194,83,158,38,20,94, -94,248,248,22,85,197,194,20,14,159,80,158,34,55,194,247,80,158,34,57,250, -80,158,37,58,196,197,248,22,59,199,83,159,34,93,80,159,34,59,35,89,162, -34,37,42,2,55,223,0,28,248,22,63,196,248,22,252,194,2,194,28,248,248, -22,83,197,194,20,14,159,80,158,34,55,194,87,94,247,80,158,34,57,248,248, -22,85,197,194,250,80,158,37,59,196,197,248,22,59,199,83,159,34,93,80,159, -34,8,26,35,248,22,252,232,2,11,83,159,34,93,80,159,34,8,27,35,32, -252,255,1,89,162,34,35,37,2,59,222,28,248,22,16,193,12,249,22,252,44, -2,2,67,6,37,37,101,120,99,101,112,116,105,111,110,32,104,97,110,100,108, -101,114,32,117,115,101,100,32,111,117,116,32,111,102,32,99,111,110,116,101,120, -116,252,0,2,96,68,35,37,107,101,114,110,101,108,252,1,2,2,102,2,101, -2,18,96,2,252,1,2,2,81,2,106,2,105,0}; - EVAL_ONE_SIZED_STR((char *)expr, 17443); +158,2,233,8,139,8,141,18,158,161,36,102,2,252,129,1,8,146,38,37,36, +8,132,16,8,8,145,11,2,252,146,1,2,252,147,1,2,252,148,1,2,252, +149,1,2,252,149,1,2,252,149,1,16,8,8,144,11,2,114,2,252,132,1, +2,252,18,1,2,252,150,1,2,252,150,1,2,252,150,1,16,4,8,143,11, +3,1,4,103,56,52,50,252,151,1,3,1,7,101,110,118,52,51,49,51,252, +152,1,16,4,8,142,11,2,252,130,1,3,1,7,101,110,118,52,51,49,52, +252,153,1,158,94,10,94,2,252,126,1,2,252,127,1,8,146,2,252,128,1, +8,146,8,146,18,158,96,10,2,252,131,1,2,252,133,1,2,252,134,1,8, +146,18,16,2,96,2,135,8,148,93,8,252,244,13,16,4,8,147,11,2,177, +3,1,7,101,110,118,52,51,49,56,252,154,1,95,9,8,252,244,13,2,94, +18,16,2,158,94,98,2,252,130,1,8,152,93,8,252,236,13,16,4,8,151, +11,3,1,8,119,115,116,109,112,56,52,48,252,155,1,3,1,7,101,110,118, +52,51,48,56,252,156,1,16,4,8,150,11,3,1,4,103,56,52,49,252,157, +1,3,1,7,101,110,118,52,51,50,51,252,158,1,16,4,8,149,11,2,252, +255,0,3,1,7,101,110,118,52,51,50,52,252,159,1,158,2,135,8,152,8, +152,95,9,8,252,236,13,2,218,18,158,95,100,2,252,131,1,8,155,38,37, +36,8,132,16,8,8,154,11,3,1,4,103,56,51,52,252,160,1,3,1,4, +103,56,51,53,252,161,1,3,1,4,103,56,51,54,252,162,1,3,1,7,101, +110,118,52,51,51,50,252,163,1,2,252,163,1,2,252,163,1,16,8,8,153, +11,2,114,2,252,132,1,2,252,18,1,3,1,7,101,110,118,52,51,51,51, +252,164,1,2,252,164,1,2,252,164,1,158,2,252,136,1,8,155,158,2,252, +137,1,8,155,8,155,11,16,5,93,2,65,89,162,34,35,51,9,223,0,27, +249,22,216,20,15,159,37,34,42,196,27,28,248,80,158,37,34,194,249,80,158, +38,35,248,80,158,39,36,196,27,248,80,158,40,37,197,28,248,80,158,40,34, +193,249,80,158,41,35,248,80,158,42,36,195,27,248,80,158,43,37,196,28,248, +80,158,43,34,193,249,80,158,44,35,248,80,158,45,36,195,27,248,80,158,46, +37,196,28,248,80,158,46,38,193,248,80,158,46,39,193,11,11,11,11,28,192, +27,248,22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22,94,197,249, +80,158,42,40,201,27,250,22,67,200,199,198,252,80,158,48,41,20,15,159,48, +35,42,21,95,3,1,4,103,56,53,52,252,165,1,3,1,4,103,56,53,54, +252,166,1,3,1,4,103,56,53,53,252,167,1,248,22,58,198,248,22,84,198, +248,22,86,198,250,22,252,47,2,11,2,79,196,34,20,99,159,34,16,8,2, +80,2,83,2,85,2,87,2,96,2,98,2,152,2,93,16,2,18,98,2,100, +8,157,38,37,36,16,4,8,156,11,2,252,19,1,3,1,7,101,110,118,52, +51,52,50,252,168,1,18,158,94,100,67,99,97,108,108,47,99,99,252,169,1, +8,160,38,37,36,8,156,16,10,8,159,11,3,1,4,103,56,53,48,252,170, +1,3,1,4,103,56,53,49,252,171,1,3,1,4,103,56,53,50,252,172,1, +3,1,4,103,56,53,51,252,173,1,3,1,7,101,110,118,52,51,52,57,252, +174,1,2,252,174,1,2,252,174,1,2,252,174,1,16,10,8,158,11,2,114, +2,199,65,98,111,100,121,49,252,175,1,64,98,111,100,121,252,176,1,3,1, +7,101,110,118,52,51,53,48,252,177,1,2,252,177,1,2,252,177,1,2,252, +177,1,158,161,10,2,252,8,1,93,2,252,165,1,2,252,166,1,2,252,167, +1,8,160,8,160,11,16,5,93,2,61,89,162,34,35,51,9,223,0,27,249, +22,216,20,15,159,37,34,44,196,27,28,248,80,158,37,34,194,249,80,158,38, +35,248,80,158,39,36,196,27,248,80,158,40,37,197,28,248,80,158,40,34,193, +249,80,158,41,35,248,80,158,42,36,195,27,248,80,158,43,37,196,28,248,80, +158,43,34,193,249,80,158,44,38,27,248,80,158,46,36,196,28,248,80,158,46, +39,193,248,22,65,248,80,158,47,40,194,11,27,248,80,158,46,37,196,28,248, +80,158,46,34,193,249,80,158,47,35,248,80,158,48,36,195,27,248,80,158,49, +37,196,28,248,80,158,49,39,193,248,80,158,49,40,193,11,11,11,11,11,28, +192,27,248,22,58,194,27,248,22,84,195,27,248,22,93,196,27,248,22,96,197, +27,248,22,95,198,249,80,158,43,41,202,27,251,22,67,200,202,201,199,250,80, +158,47,42,89,162,34,34,43,9,224,13,3,253,80,158,41,43,20,15,159,41, +35,44,21,96,3,1,4,103,56,54,51,252,178,1,3,1,4,103,56,54,50, +252,179,1,3,1,4,103,56,54,53,252,180,1,3,1,4,103,56,54,52,252, +181,1,248,22,84,199,248,22,93,199,248,22,58,199,248,22,94,199,21,98,2, +144,9,95,73,100,101,102,105,110,101,45,115,116,114,117,99,116,252,182,1,64, +98,97,115,101,252,183,1,94,65,102,105,101,108,100,252,184,1,2,135,2,252, +175,1,2,252,176,1,2,135,20,15,159,47,36,44,250,22,252,47,2,11,2, +79,196,34,20,99,159,34,16,10,2,80,2,83,2,85,2,87,2,89,2,96, +2,98,2,152,2,155,2,93,16,3,18,98,2,100,8,162,38,37,36,16,4, +8,161,11,2,252,19,1,3,1,7,101,110,118,52,51,54,50,252,185,1,18, +158,163,38,100,2,144,8,165,38,37,36,8,161,16,12,8,164,11,3,1,4, +103,56,53,55,252,186,1,3,1,4,103,56,53,56,252,187,1,3,1,4,103, +56,53,57,252,188,1,3,1,4,103,56,54,48,252,189,1,3,1,4,103,56, +54,49,252,190,1,3,1,7,101,110,118,52,51,55,49,252,191,1,2,252,191, +1,2,252,191,1,2,252,191,1,2,252,191,1,16,12,8,163,11,2,114,2, +252,183,1,2,252,184,1,2,252,175,1,2,252,176,1,3,1,7,101,110,118, +52,51,55,50,252,192,1,2,252,192,1,2,252,192,1,2,252,192,1,2,252, +192,1,158,9,8,165,158,96,10,2,252,182,1,2,252,178,1,2,252,179,1, +8,165,158,2,252,180,1,8,165,2,252,181,1,8,165,8,165,18,16,2,96, +2,135,8,167,93,8,252,27,14,16,4,8,166,11,2,177,3,1,7,101,110, +118,52,51,56,52,252,193,1,95,9,8,252,27,14,2,94,11,16,5,93,2, +70,87,95,83,159,34,93,80,159,34,8,27,35,89,162,35,35,41,9,223,0, +251,80,158,38,42,20,15,159,38,40,50,21,94,3,1,4,103,56,56,49,252, +194,1,3,1,4,103,56,56,50,252,195,1,248,22,58,198,248,22,93,198,83, +159,34,93,80,159,34,8,26,35,89,162,35,35,41,9,223,0,251,80,158,38, +42,20,15,159,38,39,50,21,94,3,1,4,103,56,56,48,252,196,1,3,1, +4,103,56,55,57,252,197,1,248,22,58,198,248,22,84,198,89,162,34,35,54, +9,223,0,27,249,22,216,20,15,159,37,34,50,196,27,28,248,80,158,37,34, +194,249,80,158,38,35,248,80,158,39,36,196,27,248,80,158,40,37,197,28,248, +80,158,40,34,193,28,248,80,158,40,38,248,80,158,41,36,194,27,248,80,158, +41,37,194,28,248,80,158,41,34,193,249,80,158,42,35,248,80,158,43,36,195, +27,248,80,158,44,37,196,28,248,80,158,44,39,193,248,80,158,44,40,193,11, +11,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,86,196, +249,80,158,41,41,200,27,249,22,67,198,197,251,80,158,46,42,20,15,159,46, +35,50,21,94,3,1,4,103,56,55,53,252,198,1,3,1,4,103,56,55,52, +252,199,1,248,22,58,197,248,22,59,197,27,28,248,80,158,38,34,195,249,80, +158,39,35,248,80,158,40,36,197,27,248,80,158,41,37,198,28,248,80,158,41, +34,193,249,80,158,42,43,27,248,80,158,44,36,196,28,248,80,158,44,39,193, +248,22,8,89,162,34,35,41,9,224,10,1,27,249,22,2,89,162,34,35,46, +9,224,4,5,249,80,158,37,44,28,248,80,158,38,34,197,249,80,158,39,35, +248,80,158,40,36,199,27,248,80,158,41,37,200,28,248,80,158,41,34,193,249, +80,158,42,35,248,80,158,43,36,195,248,80,158,43,38,248,80,158,44,37,196, +11,11,194,248,80,158,39,40,196,28,248,22,63,193,21,94,9,9,248,80,158, +37,45,193,11,27,248,80,158,44,37,196,28,248,80,158,44,34,193,249,80,158, +45,35,248,80,158,46,36,195,27,248,80,158,47,37,196,28,248,80,158,47,39, +193,248,80,158,47,40,193,11,11,11,11,28,192,27,248,22,58,194,27,248,22, +84,195,27,248,22,93,196,27,248,22,96,197,27,248,22,95,198,27,249,22,216, +20,15,159,45,36,50,248,80,158,46,46,249,80,158,48,47,20,15,159,48,37, +50,201,27,28,248,80,158,45,39,194,248,80,158,45,40,194,11,28,192,249,80, +158,46,41,205,27,252,22,67,205,203,200,202,204,250,80,158,50,48,89,162,34, +34,48,9,224,16,3,253,80,158,41,42,20,15,159,41,38,50,21,96,3,1, +4,103,56,56,56,252,200,1,3,1,4,103,56,56,53,252,201,1,3,1,4, +103,56,56,55,252,202,1,3,1,4,103,56,56,54,252,203,1,250,22,2,80, +159,44,8,26,35,248,22,93,202,248,22,95,202,252,22,2,80,159,46,8,27, +35,248,22,93,204,248,22,93,204,248,22,58,204,248,22,58,204,248,22,84,199, +248,22,96,199,21,95,2,144,94,94,63,116,109,112,252,204,1,2,252,33,1, +2,135,95,2,144,93,94,64,115,119,97,112,252,205,1,96,2,252,8,1,9, +96,2,144,93,94,2,231,2,252,204,1,95,2,252,131,1,2,252,204,1,64, +110,97,109,101,252,206,1,95,2,252,131,1,2,252,206,1,2,231,2,135,96, +72,100,121,110,97,109,105,99,45,119,105,110,100,252,207,1,2,252,205,1,97, +2,252,8,1,9,2,252,175,1,2,252,176,1,2,135,2,252,205,1,20,15, +159,50,41,50,248,80,158,45,49,20,15,159,45,42,50,250,22,252,47,2,11, +2,79,197,34,20,99,159,36,16,16,2,80,2,83,2,85,2,87,2,91,2, +96,2,98,2,152,2,93,2,89,2,211,2,213,2,252,90,1,2,215,2,155, +2,217,16,9,18,98,2,100,8,169,38,37,36,16,4,8,168,11,2,252,19, +1,3,1,7,101,110,118,52,51,56,55,252,208,1,18,158,162,37,100,2,144, +8,172,38,37,36,8,168,16,8,8,171,11,3,1,4,103,56,55,49,252,209, +1,3,1,4,103,56,55,50,252,210,1,3,1,4,103,56,55,51,252,211,1, +3,1,7,101,110,118,52,51,57,52,252,212,1,2,252,212,1,2,252,212,1, +16,8,8,170,11,2,114,2,252,175,1,2,252,176,1,3,1,7,101,110,118, +52,51,57,53,252,213,1,2,252,213,1,2,252,213,1,158,9,8,172,158,2, +252,198,1,8,172,2,252,199,1,8,172,8,172,18,100,2,100,8,175,38,37, +36,8,168,16,12,8,174,11,3,1,4,103,56,54,54,252,214,1,3,1,4, +103,56,54,55,252,215,1,3,1,4,103,56,54,56,252,216,1,3,1,4,103, +56,54,57,252,217,1,3,1,4,103,56,55,48,252,218,1,3,1,7,101,110, +118,52,52,49,52,252,219,1,2,252,219,1,2,252,219,1,2,252,219,1,2, +252,219,1,16,12,8,173,11,2,114,2,252,206,1,2,252,33,1,2,252,175, +1,2,252,176,1,3,1,7,101,110,118,52,52,49,53,252,220,1,2,252,220, +1,2,252,220,1,2,252,220,1,2,252,220,1,18,16,2,158,2,233,8,175, +8,176,18,158,95,102,2,144,8,179,38,37,36,8,168,8,174,8,173,16,4, +8,178,11,3,1,4,103,56,55,56,252,221,1,3,1,7,101,110,118,52,52, +51,50,252,222,1,16,4,8,177,11,2,252,204,1,3,1,7,101,110,118,52, +52,51,51,252,223,1,158,2,252,200,1,8,179,158,96,10,2,144,93,94,2, +252,205,1,159,2,252,8,1,9,2,252,201,1,96,2,252,207,1,2,252,205, +1,160,2,252,8,1,9,2,252,202,1,2,252,203,1,2,252,205,1,8,179, +8,179,18,158,95,10,2,252,196,1,2,252,197,1,8,179,18,158,97,10,2, +144,93,94,2,231,2,252,194,1,95,2,252,131,1,2,252,194,1,2,252,195, +1,95,2,252,131,1,2,252,195,1,2,231,8,179,18,16,2,96,2,135,8, +181,93,8,252,63,14,16,4,8,180,11,2,177,3,1,7,101,110,118,52,52, +51,55,252,224,1,95,9,8,252,63,14,2,94,18,16,2,158,94,98,2,252, +204,1,8,185,93,8,252,55,14,16,4,8,184,11,3,1,8,119,115,116,109, +112,56,55,54,252,225,1,3,1,7,101,110,118,52,52,50,55,252,226,1,16, +4,8,183,11,3,1,4,103,56,55,55,252,227,1,3,1,7,101,110,118,52, +52,52,52,252,228,1,16,4,8,182,11,2,252,255,0,3,1,7,101,110,118, +52,52,52,53,252,229,1,158,2,135,8,185,8,185,95,9,8,252,55,14,2, +218,11,16,5,93,2,71,89,162,34,35,49,9,223,0,27,249,22,216,20,15, +159,37,34,42,196,27,28,248,80,158,37,34,194,249,80,158,38,35,248,80,158, +39,36,196,27,248,80,158,40,37,197,28,248,80,158,40,34,193,249,80,158,41, +35,248,80,158,42,36,195,27,248,80,158,43,37,196,28,248,80,158,43,38,193, +248,80,158,43,39,193,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195, +27,248,22,86,196,249,80,158,41,40,200,27,249,22,67,197,198,251,80,158,46, +41,20,15,159,46,35,42,21,94,3,1,4,103,56,57,51,252,230,1,3,1, +4,103,56,57,50,252,231,1,248,22,59,197,248,22,58,197,250,22,252,47,2, +11,2,79,196,34,20,99,159,34,16,8,2,80,2,83,2,85,2,87,2,96, +2,98,2,152,2,93,16,2,18,98,2,100,8,187,38,37,36,16,4,8,186, +11,2,252,19,1,3,1,7,101,110,118,52,52,52,57,252,232,1,18,158,96, +100,2,252,129,1,8,190,38,37,36,8,186,16,8,8,189,11,3,1,4,103, +56,56,57,252,233,1,3,1,4,103,56,57,48,252,234,1,3,1,4,103,56, +57,49,252,235,1,3,1,7,101,110,118,52,52,53,53,252,236,1,2,252,236, +1,2,252,236,1,16,8,8,188,11,2,114,2,252,17,1,2,252,18,1,3, +1,7,101,110,118,52,52,53,54,252,237,1,2,252,237,1,2,252,237,1,158, +94,10,94,96,2,134,63,99,112,117,252,238,1,64,117,115,101,114,252,239,1, +62,103,99,252,240,1,95,70,116,105,109,101,45,97,112,112,108,121,252,241,1, +160,2,252,8,1,9,2,252,230,1,2,252,231,1,64,110,117,108,108,252,242, +1,8,190,158,98,10,66,112,114,105,110,116,102,252,243,1,6,40,40,99,112, +117,32,116,105,109,101,58,32,126,115,32,114,101,97,108,32,116,105,109,101,58, +32,126,115,32,103,99,32,116,105,109,101,58,32,126,115,126,110,252,244,1,2, +252,238,1,2,252,239,1,2,252,240,1,8,190,158,96,10,65,97,112,112,108, +121,252,245,1,66,118,97,108,117,101,115,252,246,1,2,134,8,190,8,190,11, +104,83,159,34,97,80,159,34,34,35,80,159,34,35,35,80,159,34,36,35,80, +159,34,37,35,80,159,34,38,35,27,247,22,252,122,2,87,94,28,192,28,248, +22,252,121,2,193,12,250,22,252,48,2,2,252,182,1,6,15,15,105,110,115, +112,101,99,116,111,114,32,111,114,32,35,102,252,247,1,195,12,91,159,39,11, +90,161,39,34,11,254,22,252,99,2,2,104,11,35,34,11,9,204,252,22,7, +197,198,199,250,22,252,101,2,203,34,61,112,252,248,1,250,22,252,102,2,204, +34,2,252,248,1,83,159,34,93,80,159,34,39,35,89,162,34,35,41,2,14, +223,0,87,94,28,248,80,158,35,36,194,12,250,22,252,48,2,2,14,6,7, +7,112,114,111,109,105,115,101,252,249,1,196,27,248,80,158,36,37,195,28,248, +22,0,193,27,249,22,6,195,22,65,87,94,28,248,22,0,248,80,158,38,37, +197,249,80,158,38,38,197,194,12,249,22,1,22,7,248,80,158,39,37,198,249, +22,1,22,7,194,83,159,34,93,80,159,34,40,35,89,162,34,34,38,2,16, +223,0,248,80,158,35,41,249,22,25,11,80,158,37,42,83,159,34,93,80,159, +34,43,35,89,162,34,36,42,2,23,223,0,87,95,28,248,22,252,231,2,194, +12,252,22,252,48,2,2,23,6,16,16,112,97,114,97,109,101,116,101,114,105, +122,97,116,105,111,110,252,250,1,34,198,199,28,28,248,22,0,195,249,22,40, +196,34,11,12,252,22,252,48,2,2,23,6,19,19,112,114,111,99,101,100,117, +114,101,32,40,97,114,105,116,121,32,48,41,252,251,1,35,198,199,20,14,159, +80,158,34,42,193,247,194,83,159,34,97,80,159,34,44,35,80,159,34,45,35, +80,159,34,46,35,80,159,34,47,35,80,159,34,48,35,252,22,252,99,2,2, +103,11,35,34,11,83,159,34,97,80,159,34,49,35,80,159,34,50,35,80,159, +34,51,35,80,159,34,52,35,80,159,34,53,35,27,247,22,252,122,2,87,94, +28,192,28,248,22,252,17,2,248,22,252,121,2,194,250,22,252,48,2,2,252, +182,1,2,252,247,1,195,12,12,91,159,39,11,90,161,39,34,11,254,22,252, +99,2,2,103,11,35,34,11,9,204,252,22,7,197,198,199,250,22,252,101,2, +203,34,64,99,101,108,108,252,252,1,250,22,252,102,2,204,34,2,252,252,1, +83,159,34,93,80,159,34,54,35,89,162,34,34,38,2,45,223,0,248,80,158, +35,45,249,22,25,11,80,158,37,55,83,159,34,93,80,159,34,56,35,89,162, +38,36,42,2,49,223,0,87,95,28,248,80,158,35,46,194,12,252,22,252,48, +2,2,49,6,22,22,98,114,101,97,107,32,112,97,114,97,109,101,116,101,114, +105,122,97,116,105,111,110,252,253,1,34,198,199,28,28,248,22,0,195,249,22, +40,196,34,11,12,252,22,252,48,2,2,23,6,19,19,112,114,111,99,101,100, +117,114,101,32,40,97,114,105,116,121,32,48,41,252,254,1,35,198,199,83,158, +38,20,94,94,20,14,159,80,158,34,55,249,80,158,36,47,195,34,87,94,247, +80,158,34,57,247,194,247,80,158,34,57,83,159,34,93,80,159,34,58,35,89, +162,34,37,42,2,53,223,0,28,248,22,63,196,248,22,252,195,2,194,28,248, +248,22,83,197,194,83,158,38,20,94,94,248,248,22,85,197,194,20,14,159,80, +158,34,55,194,247,80,158,34,57,250,80,158,37,58,196,197,248,22,59,199,83, +159,34,93,80,159,34,59,35,89,162,34,37,42,2,55,223,0,28,248,22,63, +196,248,22,252,195,2,194,28,248,248,22,83,197,194,20,14,159,80,158,34,55, +194,87,94,247,80,158,34,57,248,248,22,85,197,194,250,80,158,37,59,196,197, +248,22,59,199,83,159,34,93,80,159,34,8,26,35,248,22,252,233,2,11,83, +159,34,93,80,159,34,8,27,35,32,252,255,1,89,162,34,35,37,2,59,222, +28,248,22,16,193,12,249,22,252,45,2,2,63,6,37,37,101,120,99,101,112, +116,105,111,110,32,104,97,110,100,108,101,114,32,117,115,101,100,32,111,117,116, +32,111,102,32,99,111,110,116,101,120,116,252,0,2,96,68,35,37,107,101,114, +110,101,108,252,1,2,2,102,2,101,2,18,96,2,252,1,2,2,81,2,106, +2,105,0}; + EVAL_ONE_SIZED_STR((char *)expr, 17495); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,252,243,1,252,151,52,159,34,20,99,159,34,16, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,252,243,1,252,151,52,159,34,20,99,159,34,16, 1,20,24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,66,35,37, 109,105,115,99,1,29,2,11,11,10,10,10,46,80,158,34,34,20,99,159,39, 16,47,30,3,2,2,72,112,97,116,104,45,115,116,114,105,110,103,63,4,254, @@ -3518,11 +3524,11 @@ 193,248,80,158,43,39,193,11,11,11,28,192,27,248,22,58,194,27,248,22,84, 195,27,248,22,86,196,27,249,22,216,20,15,159,42,35,41,249,22,216,203,247, 22,54,27,249,22,216,20,15,159,43,36,41,249,22,216,204,247,22,54,27,249, -22,216,20,15,159,44,37,41,249,22,216,205,247,22,54,27,252,22,67,199,198, -201,200,202,254,80,158,50,40,20,15,159,50,38,41,21,97,3,1,4,103,57, +22,216,20,15,159,44,37,41,249,22,216,205,247,22,54,27,252,22,67,198,201, +200,202,199,254,80,158,50,40,20,15,159,50,38,41,21,97,3,1,4,103,57, 48,54,99,3,1,4,103,57,49,50,100,3,1,4,103,57,49,49,101,3,1, -4,103,57,48,56,102,3,1,4,103,57,48,57,103,248,22,96,200,248,22,58, -200,248,22,95,200,248,22,84,200,248,22,93,200,250,22,252,46,2,11,6,10, +4,103,57,48,56,102,3,1,4,103,57,48,57,103,248,22,93,200,248,22,95, +200,248,22,96,200,248,22,58,200,248,22,84,200,250,22,252,47,2,11,6,10, 10,98,97,100,32,115,121,110,116,97,120,104,196,34,20,99,159,34,16,7,30, 105,65,35,37,115,116,120,106,69,115,116,120,45,112,97,105,114,63,107,11,30, 108,2,106,67,99,111,110,115,47,35,102,109,1,30,110,2,106,67,115,116,120, @@ -3534,16 +3540,16 @@ 38,10,34,11,96,159,68,35,37,100,101,102,105,110,101,122,9,11,159,70,35, 37,109,101,109,116,114,97,99,101,123,9,11,159,74,35,37,115,109,97,108,108, 45,115,99,104,101,109,101,124,9,11,159,73,35,37,109,111,114,101,45,115,99, -104,101,109,101,125,9,11,16,92,2,57,2,2,2,59,2,2,2,91,2,2, -2,45,2,2,2,63,2,2,2,69,2,2,2,79,2,2,2,95,2,2,2, -4,2,2,2,37,2,2,2,8,2,2,2,73,2,2,2,12,2,2,2,97, -2,2,2,65,2,2,2,71,2,2,2,98,2,2,2,51,2,2,2,27,2, -2,2,10,2,2,2,23,2,2,2,14,2,2,2,35,2,2,2,6,2,2, -2,83,2,2,2,77,2,2,2,47,2,2,2,75,2,2,2,81,2,2,2, -16,2,2,2,67,2,2,2,43,2,2,2,29,2,2,2,93,2,2,2,33, -2,2,2,85,2,2,2,41,2,2,2,55,2,2,2,61,2,2,2,25,2, -2,2,49,2,2,2,89,2,2,2,31,2,2,2,39,2,2,2,53,2,2, -2,87,2,2,98,37,10,35,11,94,159,76,35,37,115,116,120,99,97,115,101, +104,101,109,101,125,9,11,16,92,2,55,2,2,2,53,2,2,2,95,2,2, +2,31,2,2,2,47,2,2,2,59,2,2,2,51,2,2,2,57,2,2,2, +63,2,2,2,23,2,2,2,49,2,2,2,85,2,2,2,39,2,2,2,4, +2,2,2,14,2,2,2,81,2,2,2,61,2,2,2,91,2,2,2,41,2, +2,2,8,2,2,2,93,2,2,2,12,2,2,2,43,2,2,2,75,2,2, +2,97,2,2,2,71,2,2,2,79,2,2,2,29,2,2,2,16,2,2,2, +35,2,2,2,98,2,2,2,65,2,2,2,73,2,2,2,27,2,2,2,45, +2,2,2,67,2,2,2,25,2,2,2,87,2,2,2,37,2,2,2,83,2, +2,2,33,2,2,2,89,2,2,2,77,2,2,2,69,2,2,2,6,2,2, +2,10,2,2,98,37,10,35,11,94,159,76,35,37,115,116,120,99,97,115,101, 45,115,99,104,101,109,101,126,9,11,159,2,106,9,11,16,0,96,36,8,254, 1,11,16,0,16,4,35,11,61,120,127,3,1,7,101,110,118,52,52,57,54, 128,18,100,2,121,43,38,37,36,35,16,8,42,11,3,1,4,103,56,57,52, @@ -3568,74 +3574,74 @@ 110,101,119,45,109,101,109,116,114,97,99,101,45,116,114,97,99,107,105,110,103, 45,102,117,110,99,116,105,111,110,155,2,100,2,100,51,51,11,139,83,159,34, 93,80,159,34,8,51,35,89,162,8,64,35,44,64,108,111,111,112,156,223,0, -28,248,22,63,194,9,27,248,22,58,195,27,28,248,22,252,55,3,194,193,28, -248,22,252,54,3,194,249,22,252,56,3,195,250,80,158,41,48,248,22,252,69, +28,248,22,63,194,9,27,248,22,58,195,27,28,248,22,252,56,3,194,193,28, +248,22,252,55,3,194,249,22,252,57,3,195,250,80,158,41,48,248,22,252,70, 3,69,101,120,101,99,45,102,105,108,101,157,11,10,250,80,158,39,48,248,22, -252,69,3,2,157,196,10,28,192,249,22,57,248,22,252,58,3,249,22,252,56, -3,197,247,22,252,70,3,248,80,159,39,8,51,35,248,22,59,199,248,80,159, +252,70,3,2,157,196,10,28,192,249,22,57,248,22,252,59,3,249,22,252,57, +3,197,247,22,252,71,3,248,80,159,39,8,51,35,248,22,59,199,248,80,159, 37,8,51,35,248,22,59,197,83,159,34,93,80,159,34,8,50,35,89,162,34, -35,47,67,103,101,116,45,100,105,114,158,223,0,27,28,194,28,249,22,252,18, +35,47,67,103,101,116,45,100,105,114,158,223,0,27,28,194,28,249,22,252,19, 2,196,80,158,37,8,29,80,158,35,8,30,27,248,22,252,220,1,248,22,50, -197,28,249,22,252,81,3,33,8,35,114,120,35,34,94,44,34,159,194,91,159, -37,11,90,161,37,34,11,248,22,252,52,3,248,22,252,41,3,250,22,252,204, +197,28,249,22,252,82,3,33,8,35,114,120,35,34,94,44,34,159,194,91,159, +37,11,90,161,37,34,11,248,22,252,53,3,248,22,252,42,3,250,22,252,204, 1,200,35,248,22,252,198,1,201,87,95,83,160,36,11,80,158,39,8,29,198, 83,160,36,11,80,158,39,8,30,192,192,11,11,28,192,192,27,247,22,252,97, -1,28,192,192,247,22,252,70,3,83,159,34,93,80,159,34,8,49,35,89,162, -34,35,43,9,223,0,87,94,28,27,248,22,252,33,3,195,28,192,192,28,248, -22,252,143,1,195,27,248,22,252,53,3,196,28,192,192,248,22,252,54,3,196, -11,12,250,22,252,47,2,2,47,6,25,25,112,97,116,104,32,111,114,32,118, +1,28,192,192,247,22,252,71,3,83,159,34,93,80,159,34,8,49,35,89,162, +34,35,43,9,223,0,87,94,28,27,248,22,252,34,3,195,28,192,192,28,248, +22,252,143,1,195,27,248,22,252,54,3,196,28,192,192,248,22,252,55,3,196, +11,12,250,22,252,48,2,2,47,6,25,25,112,97,116,104,32,111,114,32,118, 97,108,105,100,45,112,97,116,104,32,115,116,114,105,110,103,160,196,28,248,22, -252,53,3,194,12,248,22,252,194,2,249,22,252,138,2,248,22,252,172,1,250, +252,54,3,194,12,248,22,252,195,2,249,22,252,139,2,248,22,252,172,1,250, 22,252,191,1,6,29,29,126,97,58,32,105,110,118,97,108,105,100,32,114,101, 108,97,116,105,118,101,32,112,97,116,104,58,32,126,115,161,2,47,200,247,22, 21,83,159,34,93,80,159,34,8,48,35,89,162,34,36,42,68,119,105,116,104, 45,100,105,114,162,223,0,20,14,159,80,158,34,41,250,80,158,37,42,249,22, -25,11,80,158,39,41,22,252,97,1,28,248,22,252,33,3,197,196,247,22,252, -70,3,247,194,83,159,34,93,80,159,34,8,47,35,89,162,8,36,37,38,66, +25,11,80,158,39,41,22,252,97,1,28,248,22,252,34,3,197,196,247,22,252, +71,3,247,194,83,159,34,93,80,159,34,8,47,35,89,162,8,36,37,38,66, 103,101,116,45,115,111,163,223,0,89,162,34,35,46,9,226,0,1,3,2,252, -22,252,49,3,199,201,6,6,6,110,97,116,105,118,101,164,247,22,252,227,1, +22,252,50,3,199,201,6,6,6,110,97,116,105,118,101,164,247,22,252,227,1, 28,198,249,80,159,44,36,35,199,80,158,44,52,197,83,159,34,93,80,159,34, -34,35,32,165,89,162,34,35,38,2,4,222,27,248,22,252,33,3,194,28,192, -192,28,248,22,252,143,1,194,27,248,22,252,53,3,195,28,192,192,248,22,252, -54,3,195,11,83,159,34,93,80,159,34,35,35,33,18,35,114,120,35,34,40, +34,35,32,165,89,162,34,35,38,2,4,222,27,248,22,252,34,3,194,28,192, +192,28,248,22,252,143,1,194,27,248,22,252,54,3,195,28,192,192,248,22,252, +55,3,195,11,83,159,34,93,80,159,34,35,35,33,18,35,114,120,35,34,40, 91,46,93,91,94,46,93,42,124,41,36,34,166,83,159,34,93,80,159,34,36, -35,89,162,34,36,48,2,8,223,0,87,95,28,28,248,22,252,34,3,194,10, -27,248,22,252,33,3,195,28,192,192,28,248,22,252,143,1,195,27,248,22,252, -53,3,196,28,192,192,248,22,252,54,3,196,11,12,252,22,252,47,2,2,8, +35,89,162,34,36,48,2,8,223,0,87,95,28,28,248,22,252,35,3,194,10, +27,248,22,252,34,3,195,28,192,192,28,248,22,252,143,1,195,27,248,22,252, +54,3,196,28,192,192,248,22,252,55,3,196,11,12,252,22,252,48,2,2,8, 6,42,42,112,97,116,104,32,40,102,111,114,32,97,110,121,32,115,121,115,116, 101,109,41,32,111,114,32,118,97,108,105,100,45,112,97,116,104,32,115,116,114, 105,110,103,167,34,198,199,28,28,248,22,252,143,1,195,10,248,22,252,195,1, -195,12,252,22,252,47,2,2,8,6,21,21,115,116,114,105,110,103,32,111,114, +195,12,252,22,252,48,2,2,8,6,21,21,115,116,114,105,110,103,32,111,114, 32,98,121,116,101,32,115,116,114,105,110,103,168,35,198,199,91,159,37,11,90, -161,37,34,11,248,22,252,52,3,197,87,94,28,192,12,250,22,252,48,2,2, +161,37,34,11,248,22,252,53,3,197,87,94,28,192,12,250,22,252,49,2,2, 8,6,36,36,99,97,110,110,111,116,32,97,100,100,32,97,32,115,117,102,102, 105,120,32,116,111,32,97,32,114,111,111,116,32,112,97,116,104,58,32,169,199, -27,249,22,252,42,3,250,22,252,87,3,2,166,248,22,252,39,3,200,28,248, -22,252,143,1,204,249,22,252,219,1,205,8,63,203,28,248,22,252,34,3,200, -248,22,252,35,3,200,247,22,252,36,3,28,248,22,252,33,3,194,249,22,252, -49,3,195,194,192,83,159,34,93,80,159,34,37,35,249,22,252,145,1,7,92, +27,249,22,252,43,3,250,22,252,88,3,2,166,248,22,252,40,3,200,28,248, +22,252,143,1,204,249,22,252,219,1,205,8,63,203,28,248,22,252,35,3,200, +248,22,252,36,3,200,247,22,252,37,3,28,248,22,252,34,3,194,249,22,252, +50,3,195,194,192,83,159,34,93,80,159,34,37,35,249,22,252,145,1,7,92, 7,92,83,159,34,93,80,159,34,38,35,89,162,34,35,47,2,12,223,0,87, -94,28,28,248,22,252,34,3,194,10,27,248,22,252,33,3,195,28,192,192,28, -248,22,252,143,1,195,27,248,22,252,53,3,196,28,192,192,248,22,252,54,3, -196,11,12,250,22,252,47,2,76,110,111,114,109,97,108,45,112,97,116,104,45, +94,28,28,248,22,252,35,3,194,10,27,248,22,252,34,3,195,28,192,192,28, +248,22,252,143,1,195,27,248,22,252,54,3,196,28,192,192,248,22,252,55,3, +196,11,12,250,22,252,48,2,76,110,111,114,109,97,108,45,112,97,116,104,45, 99,97,115,101,170,6,42,42,112,97,116,104,32,40,102,111,114,32,97,110,121, 32,115,121,115,116,101,109,41,32,111,114,32,118,97,108,105,100,45,112,97,116, -104,32,115,116,114,105,110,103,171,196,28,28,248,22,252,34,3,194,249,22,252, -18,2,248,22,252,35,3,196,67,119,105,110,100,111,119,115,172,249,22,252,18, +104,32,115,116,114,105,110,103,171,196,28,28,248,22,252,35,3,194,249,22,252, +19,2,248,22,252,36,3,196,67,119,105,110,100,111,119,115,172,249,22,252,19, 2,247,22,252,226,1,2,172,27,28,248,22,252,143,1,195,194,248,22,252,216, -1,248,22,252,38,3,196,28,249,22,252,81,3,33,21,35,114,120,34,94,91, +1,248,22,252,39,3,196,28,249,22,252,82,3,33,21,35,114,120,34,94,91, 92,92,93,91,92,92,93,91,63,93,91,92,92,93,34,173,194,28,248,22,252, -143,1,195,248,22,252,40,3,195,194,27,248,22,252,182,1,194,249,22,252,41, -3,248,22,252,219,1,250,22,252,88,3,33,6,35,114,120,34,47,34,174,28, -249,22,252,81,3,33,22,35,114,120,34,91,47,92,92,93,91,46,32,93,43, -91,47,92,92,93,42,36,34,175,200,198,250,22,252,88,3,33,19,35,114,120, +143,1,195,248,22,252,41,3,195,194,27,248,22,252,182,1,194,249,22,252,42, +3,248,22,252,219,1,250,22,252,89,3,33,6,35,114,120,34,47,34,174,28, +249,22,252,82,3,33,22,35,114,120,34,91,47,92,92,93,91,46,32,93,43, +91,47,92,92,93,42,36,34,175,200,198,250,22,252,89,3,33,19,35,114,120, 34,91,32,46,93,43,40,91,47,92,92,93,42,41,36,34,176,201,6,2,2, -92,49,177,80,158,42,37,2,172,28,248,22,252,143,1,194,248,22,252,40,3, +92,49,177,80,158,42,37,2,172,28,248,22,252,143,1,194,248,22,252,41,3, 194,193,83,159,34,93,80,159,34,39,35,91,159,36,11,90,161,35,35,11,32, 178,89,162,8,64,35,38,65,99,104,101,99,107,179,222,28,248,22,136,193,12, -250,22,252,47,2,2,14,6,4,4,114,101,97,108,180,195,20,12,95,35,89, -162,8,36,36,53,2,14,223,0,87,95,28,248,22,136,194,12,250,22,252,47, -2,2,14,2,180,196,28,248,22,136,195,12,250,22,252,47,2,2,14,2,180, +250,22,252,48,2,2,14,6,4,4,114,101,97,108,180,195,20,12,95,35,89, +162,8,36,36,53,2,14,223,0,87,95,28,248,22,136,194,12,250,22,252,48, +2,2,14,2,180,196,28,248,22,136,195,12,250,22,252,48,2,2,14,2,180, 197,27,248,22,183,196,27,249,22,180,197,195,27,249,22,179,198,196,28,249,22, 188,198,198,28,250,22,191,196,34,195,28,248,22,139,197,34,33,3,48,46,48, 181,28,248,22,195,194,248,22,180,27,248,22,180,195,27,248,22,180,197,28,248, @@ -3653,144 +3659,144 @@ 203,201,83,159,34,93,80,159,34,40,35,89,162,34,34,42,2,16,223,0,27, 247,22,54,27,89,162,34,34,38,1,25,114,101,112,108,45,101,114,114,111,114, 45,101,115,99,97,112,101,45,104,97,110,100,108,101,114,184,223,1,27,249,22, -25,11,195,28,192,247,192,249,22,252,44,2,2,184,6,19,19,117,115,101,100, +25,11,195,28,192,247,192,249,22,252,45,2,2,184,6,19,19,117,115,101,100, 32,111,117,116,32,111,102,32,99,111,110,116,101,120,116,185,20,14,159,80,158, -36,41,250,80,158,39,42,249,22,25,11,80,158,41,41,22,252,52,2,195,248, +36,41,250,80,158,39,42,249,22,25,11,80,158,41,41,22,252,53,2,195,248, 22,8,89,162,34,35,39,9,223,2,249,32,186,89,162,34,36,38,69,114,101, 112,108,45,108,111,111,112,187,222,87,94,248,22,8,89,162,34,35,40,9,224, 2,1,20,14,159,193,194,27,247,247,22,46,87,94,28,248,22,252,77,1,193, 248,194,12,12,83,159,45,32,188,89,162,35,35,37,9,222,249,22,3,247,22, -45,194,248,247,22,252,39,2,28,248,22,213,194,248,22,252,37,2,194,193,249, +45,194,248,247,22,252,40,2,28,248,22,213,194,248,22,252,38,2,194,193,249, 2,186,194,195,195,194,83,159,34,93,80,159,34,43,35,32,189,89,162,34,35, -45,2,23,222,87,94,28,27,248,22,252,33,3,194,28,192,192,28,248,22,252, -143,1,194,27,248,22,252,53,3,195,28,192,192,248,22,252,54,3,195,11,12, -250,22,252,47,2,2,23,6,25,25,112,97,116,104,32,111,114,32,115,116,114, +45,2,23,222,87,94,28,27,248,22,252,34,3,194,28,192,192,28,248,22,252, +143,1,194,27,248,22,252,54,3,195,28,192,192,248,22,252,55,3,195,11,12, +250,22,252,48,2,2,23,6,25,25,112,97,116,104,32,111,114,32,115,116,114, 105,110,103,32,40,115,97,110,115,32,110,117,108,41,190,195,91,159,37,11,90, -161,37,34,11,248,22,252,52,3,196,28,194,248,22,252,194,2,249,22,252,168, +161,37,34,11,248,22,252,53,3,196,28,194,248,22,252,195,2,249,22,252,169, 2,248,22,252,172,1,249,22,252,191,1,6,36,36,108,111,97,100,47,99,100, 58,32,99,97,110,110,111,116,32,111,112,101,110,32,97,32,100,105,114,101,99, -116,111,114,121,58,32,126,115,191,201,247,22,21,28,248,22,252,33,3,193,87, -94,28,248,22,252,44,3,193,12,248,22,252,194,2,249,22,252,168,2,248,22, +116,111,114,121,58,32,126,115,191,201,247,22,21,28,248,22,252,34,3,193,87, +94,28,248,22,252,45,3,193,12,248,22,252,195,2,249,22,252,169,2,248,22, 252,172,1,250,22,252,191,1,6,65,65,108,111,97,100,47,99,100,58,32,100, 105,114,101,99,116,111,114,121,32,111,102,32,126,115,32,100,111,101,115,32,110, 111,116,32,101,120,105,115,116,32,40,99,117,114,114,101,110,116,32,100,105,114, -101,99,116,111,114,121,32,105,115,32,126,115,41,192,202,247,22,252,70,3,247, -22,21,27,247,22,252,70,3,250,22,37,89,162,34,34,36,9,223,4,248,22, -252,70,3,193,89,162,34,34,36,9,223,5,248,22,252,95,1,193,89,162,34, -34,36,9,223,3,248,22,252,70,3,193,248,22,252,95,1,196,83,159,34,93, +101,99,116,111,114,121,32,105,115,32,126,115,41,192,202,247,22,252,71,3,247, +22,21,27,247,22,252,71,3,250,22,37,89,162,34,34,36,9,223,4,248,22, +252,71,3,193,89,162,34,34,36,9,223,5,248,22,252,95,1,193,89,162,34, +34,36,9,223,3,248,22,252,71,3,193,248,22,252,95,1,196,83,159,34,93, 80,159,34,44,35,32,193,89,162,34,37,41,2,25,222,87,94,28,27,248,22, -252,33,3,196,28,192,192,28,248,22,252,143,1,196,27,248,22,252,53,3,197, -28,192,192,248,22,252,54,3,197,11,12,250,22,252,47,2,196,6,25,25,112, +252,34,3,196,28,192,192,28,248,22,252,143,1,196,27,248,22,252,54,3,197, +28,192,192,248,22,252,55,3,197,11,12,250,22,252,48,2,196,6,25,25,112, 97,116,104,32,111,114,32,115,116,114,105,110,103,32,40,115,97,110,115,32,110, -117,108,41,194,197,28,248,22,252,55,3,195,248,193,195,27,247,22,252,97,1, -248,194,28,193,249,22,252,56,3,198,195,196,83,159,34,93,80,159,34,45,35, -89,162,34,35,40,2,27,223,0,87,94,28,27,248,22,252,33,3,195,28,192, -192,28,248,22,252,143,1,195,27,248,22,252,53,3,196,28,192,192,248,22,252, -54,3,196,11,12,250,22,252,47,2,2,27,2,194,196,28,248,22,252,55,3, +117,108,41,194,197,28,248,22,252,56,3,195,248,193,195,27,247,22,252,97,1, +248,194,28,193,249,22,252,57,3,198,195,196,83,159,34,93,80,159,34,45,35, +89,162,34,35,40,2,27,223,0,87,94,28,27,248,22,252,34,3,195,28,192, +192,28,248,22,252,143,1,195,27,248,22,252,54,3,196,28,192,192,248,22,252, +55,3,196,11,12,250,22,252,48,2,2,27,2,194,196,28,248,22,252,56,3, 194,248,22,252,95,1,194,27,247,22,252,97,1,248,22,252,95,1,28,193,249, -22,252,56,3,197,195,195,83,159,34,93,80,159,34,46,35,89,162,34,35,40, -2,29,223,0,87,94,28,27,248,22,252,33,3,195,28,192,192,28,248,22,252, -143,1,195,27,248,22,252,53,3,196,28,192,192,248,22,252,54,3,196,11,12, -250,22,252,47,2,2,29,2,194,196,28,248,22,252,55,3,194,248,22,252,74, -3,194,27,247,22,252,97,1,248,22,252,74,3,28,193,249,22,252,56,3,197, -195,195,83,159,34,93,80,159,34,47,35,27,248,22,252,76,3,248,22,252,218, +22,252,57,3,197,195,195,83,159,34,93,80,159,34,46,35,89,162,34,35,40, +2,29,223,0,87,94,28,27,248,22,252,34,3,195,28,192,192,28,248,22,252, +143,1,195,27,248,22,252,54,3,196,28,192,192,248,22,252,55,3,196,11,12, +250,22,252,48,2,2,29,2,194,196,28,248,22,252,56,3,194,248,22,252,75, +3,194,27,247,22,252,97,1,248,22,252,75,3,28,193,249,22,252,57,3,197, +195,195,83,159,34,93,80,159,34,47,35,27,248,22,252,77,3,248,22,252,218, 1,27,27,247,22,252,226,1,28,249,22,78,194,21,96,64,117,110,105,120,195, 64,98,101,111,115,196,65,111,115,107,105,116,197,66,109,97,99,111,115,120,198, 6,1,1,58,199,28,249,22,78,194,21,94,2,172,65,109,97,99,111,115,200, 6,1,1,59,201,12,250,22,252,191,1,6,14,14,40,91,94,126,97,93,42, 41,126,97,40,46,42,41,202,195,195,89,162,8,36,36,42,2,31,223,0,87, -95,28,28,248,22,252,195,1,194,10,248,22,252,143,1,194,12,250,22,252,47, +95,28,28,248,22,252,195,1,194,10,248,22,252,143,1,194,12,250,22,252,48, 2,2,31,6,21,21,98,121,116,101,32,115,116,114,105,110,103,32,111,114,32, -115,116,114,105,110,103,203,196,28,28,248,22,64,195,249,22,4,22,252,33,3, -196,11,12,250,22,252,47,2,2,31,6,13,13,108,105,115,116,32,111,102,32, +115,116,114,105,110,103,203,196,28,28,248,22,64,195,249,22,4,22,252,34,3, +196,11,12,250,22,252,48,2,2,31,6,13,13,108,105,115,116,32,111,102,32, 112,97,116,104,115,204,197,250,32,205,89,162,8,64,37,44,2,156,222,27,249, -22,252,80,3,196,197,28,192,27,248,22,84,194,27,250,2,205,198,199,248,22, +22,252,81,3,196,197,28,192,27,248,22,84,194,27,250,2,205,198,199,248,22, 93,198,28,249,22,252,201,1,195,5,0,206,249,22,71,197,194,249,22,57,248, -22,252,41,3,196,194,28,249,22,252,201,1,197,2,206,249,22,71,195,9,249, -22,57,248,22,252,41,3,198,9,197,195,28,248,22,252,143,1,197,248,22,252, +22,252,42,3,196,194,28,249,22,252,201,1,197,2,206,249,22,71,195,9,249, +22,57,248,22,252,42,3,198,9,197,195,28,248,22,252,143,1,197,248,22,252, 218,1,197,196,83,159,34,93,80,159,34,48,35,83,158,37,20,93,96,2,33, -89,162,8,36,37,49,9,223,0,87,95,28,27,248,22,252,33,3,195,28,192, -192,28,248,22,252,143,1,195,27,248,22,252,53,3,196,28,192,192,248,22,252, -54,3,196,11,12,250,22,252,47,2,2,33,6,25,25,112,97,116,104,32,111, +89,162,8,36,37,49,9,223,0,87,95,28,27,248,22,252,34,3,195,28,192, +192,28,248,22,252,143,1,195,27,248,22,252,54,3,196,28,192,192,248,22,252, +55,3,196,11,12,250,22,252,48,2,2,33,6,25,25,112,97,116,104,32,111, 114,32,115,116,114,105,110,103,32,40,115,97,110,115,32,110,117,108,41,207,196, -28,28,194,28,27,248,22,252,33,3,196,28,192,192,28,248,22,252,143,1,196, -27,248,22,252,53,3,197,28,192,192,248,22,252,54,3,197,11,248,22,252,53, -3,195,11,10,12,250,22,252,47,2,2,33,6,29,29,35,102,32,111,114,32, +28,28,194,28,27,248,22,252,34,3,196,28,192,192,28,248,22,252,143,1,196, +27,248,22,252,54,3,197,28,192,192,248,22,252,55,3,197,11,248,22,252,54, +3,195,11,10,12,250,22,252,48,2,2,33,6,29,29,35,102,32,111,114,32, 114,101,108,97,116,105,118,101,32,112,97,116,104,32,111,114,32,115,116,114,105, -110,103,208,197,28,28,248,22,252,53,3,194,91,159,37,11,90,161,37,34,11, -248,22,252,52,3,197,249,22,252,18,2,194,68,114,101,108,97,116,105,118,101, +110,103,208,197,28,28,248,22,252,54,3,194,91,159,37,11,90,161,37,34,11, +248,22,252,53,3,197,249,22,252,19,2,194,68,114,101,108,97,116,105,118,101, 209,11,27,248,22,252,224,1,6,4,4,80,65,84,72,210,27,28,193,27,249, -80,158,39,47,196,9,28,249,22,252,18,2,247,22,252,226,1,2,172,249,22, -57,248,22,252,41,3,5,1,46,211,194,192,9,28,248,22,63,193,11,27,248, -22,252,56,3,248,22,58,195,27,249,22,252,49,3,195,199,28,248,22,252,43, +80,158,39,47,196,9,28,249,22,252,19,2,247,22,252,226,1,2,172,249,22, +57,248,22,252,42,3,5,1,46,211,194,192,9,28,248,22,63,193,11,27,248, +22,252,57,3,248,22,58,195,27,249,22,252,50,3,195,199,28,248,22,252,44, 3,193,250,32,212,89,162,8,100,37,48,70,102,111,117,110,100,45,101,120,101, -99,213,222,28,192,91,159,37,11,90,161,37,34,11,248,22,252,52,3,198,27, -28,197,27,248,22,252,57,3,200,28,249,22,252,20,2,194,201,11,28,248,22, -252,53,3,193,250,2,212,200,201,249,22,252,49,3,199,197,250,2,212,200,201, -195,11,28,192,192,27,28,248,22,252,33,3,195,27,249,22,252,49,3,197,200, -28,28,248,22,252,44,3,193,10,248,22,252,43,3,193,192,11,11,28,192,192, -28,198,11,27,248,22,252,57,3,201,28,249,22,252,20,2,194,202,11,28,248, -22,252,53,3,193,250,2,212,201,202,249,22,252,49,3,200,197,250,2,212,201, +99,213,222,28,192,91,159,37,11,90,161,37,34,11,248,22,252,53,3,198,27, +28,197,27,248,22,252,58,3,200,28,249,22,252,21,2,194,201,11,28,248,22, +252,54,3,193,250,2,212,200,201,249,22,252,50,3,199,197,250,2,212,200,201, +195,11,28,192,192,27,28,248,22,252,34,3,195,27,249,22,252,50,3,197,200, +28,28,248,22,252,45,3,193,10,248,22,252,44,3,193,192,11,11,28,192,192, +28,198,11,27,248,22,252,58,3,201,28,249,22,252,21,2,194,202,11,28,248, +22,252,54,3,193,250,2,212,201,202,249,22,252,50,3,200,197,250,2,212,201, 202,195,194,201,202,195,251,32,214,89,162,8,100,38,48,2,156,222,28,248,22, -63,196,11,27,248,22,252,56,3,248,22,58,198,27,249,22,252,49,3,195,196, -28,248,22,252,43,3,193,250,2,212,198,199,195,27,248,22,59,199,28,248,22, -63,193,11,27,248,22,252,56,3,248,22,58,195,27,249,22,252,49,3,195,199, -28,248,22,252,43,3,193,250,2,212,201,202,195,251,2,214,201,202,203,248,22, -59,199,201,202,203,248,22,59,199,27,248,22,252,56,3,195,28,248,22,252,43, +63,196,11,27,248,22,252,57,3,248,22,58,198,27,249,22,252,50,3,195,196, +28,248,22,252,44,3,193,250,2,212,198,199,195,27,248,22,59,199,28,248,22, +63,193,11,27,248,22,252,57,3,248,22,58,195,27,249,22,252,50,3,195,199, +28,248,22,252,44,3,193,250,2,212,201,202,195,251,2,214,201,202,203,248,22, +59,199,201,202,203,248,22,59,199,27,248,22,252,57,3,195,28,248,22,252,44, 3,193,250,2,212,198,199,195,11,89,162,34,36,40,9,223,0,250,80,158,37, 48,196,197,11,89,162,34,35,39,9,223,0,250,80,158,37,48,196,11,11,83, 159,34,93,80,159,34,49,35,32,215,89,162,34,36,43,2,35,222,87,94,28, -27,248,22,252,33,3,195,28,192,192,28,248,22,252,143,1,195,27,248,22,252, -53,3,196,28,192,192,248,22,252,54,3,196,11,12,250,22,252,47,2,195,2, -160,196,28,248,22,252,53,3,194,12,248,22,252,194,2,249,22,252,138,2,248, +27,248,22,252,34,3,195,28,192,192,28,248,22,252,143,1,195,27,248,22,252, +54,3,196,28,192,192,248,22,252,55,3,196,11,12,250,22,252,48,2,195,2, +160,196,28,248,22,252,54,3,194,12,248,22,252,195,2,249,22,252,139,2,248, 22,252,172,1,250,22,252,191,1,2,161,199,200,247,22,21,83,159,34,93,80, 159,34,50,35,89,162,34,37,45,2,37,223,0,87,94,87,94,28,27,248,22, -252,33,3,196,28,192,192,28,248,22,252,143,1,196,27,248,22,252,53,3,197, -28,192,192,248,22,252,54,3,197,11,12,250,22,252,47,2,196,2,160,197,28, -248,22,252,53,3,195,12,248,22,252,194,2,249,22,252,138,2,248,22,252,172, +252,34,3,196,28,192,192,28,248,22,252,143,1,196,27,248,22,252,54,3,197, +28,192,192,248,22,252,55,3,197,11,12,250,22,252,48,2,196,2,160,197,28, +248,22,252,54,3,195,12,248,22,252,195,2,249,22,252,139,2,248,22,252,172, 1,250,22,252,191,1,2,161,200,201,247,22,21,249,22,3,89,162,34,35,44, -9,224,2,3,87,94,28,27,248,22,252,33,3,196,28,192,192,28,248,22,252, -143,1,196,27,248,22,252,53,3,197,28,192,192,248,22,252,54,3,197,11,12, -250,22,252,47,2,195,2,160,197,28,248,22,252,53,3,195,12,248,22,252,194, -2,249,22,252,138,2,248,22,252,172,1,250,22,252,191,1,2,161,199,201,247, +9,224,2,3,87,94,28,27,248,22,252,34,3,196,28,192,192,28,248,22,252, +143,1,196,27,248,22,252,54,3,197,28,192,192,248,22,252,55,3,197,11,12, +250,22,252,48,2,195,2,160,197,28,248,22,252,54,3,195,12,248,22,252,195, +2,249,22,252,139,2,248,22,252,172,1,250,22,252,191,1,2,161,199,201,247, 22,21,197,83,159,34,93,80,159,34,51,35,32,216,89,162,34,37,44,2,39, -222,27,247,22,252,71,3,252,32,217,89,162,8,64,39,50,65,99,108,111,111, -112,218,222,28,248,22,63,197,248,22,252,194,2,249,22,252,168,2,248,22,252, +222,27,247,22,252,72,3,252,32,217,89,162,8,64,39,50,65,99,108,111,111, +112,218,222,28,248,22,63,197,248,22,252,195,2,249,22,252,169,2,248,22,252, 172,1,251,22,252,191,1,6,42,42,126,97,58,32,99,111,108,108,101,99,116, 105,111,110,32,110,111,116,32,102,111,117,110,100,58,32,126,115,32,105,110,32, 97,110,121,32,111,102,58,32,126,115,219,201,28,248,22,63,204,202,250,22,1, -22,252,49,3,205,206,200,247,22,21,27,249,22,252,49,3,248,22,58,200,197, -28,248,22,252,44,3,193,27,250,22,1,22,252,49,3,196,200,28,248,22,252, -44,3,193,192,252,2,217,199,200,201,202,248,22,59,204,252,2,217,198,199,200, +22,252,50,3,205,206,200,247,22,21,27,249,22,252,50,3,248,22,58,200,197, +28,248,22,252,45,3,193,27,250,22,1,22,252,50,3,196,200,28,248,22,252, +45,3,193,192,252,2,217,199,200,201,202,248,22,59,204,252,2,217,198,199,200, 201,248,22,59,203,197,198,199,200,197,83,159,34,93,80,159,34,52,35,27,247, -22,252,226,1,28,249,22,252,18,2,194,2,172,5,4,46,100,108,108,220,28, +22,252,226,1,28,249,22,252,19,2,194,2,172,5,4,46,100,108,108,220,28, 249,22,78,194,21,94,2,198,2,200,5,6,46,100,121,108,105,98,221,5,3, 46,115,111,222,83,159,34,93,80,159,34,53,35,249,80,159,36,36,35,248,22, -252,41,3,5,10,95,108,111,97,100,101,114,46,115,115,223,80,158,36,52,83, -159,34,93,80,159,34,54,35,249,22,252,228,2,27,89,162,34,36,8,28,1, +252,42,3,5,10,95,108,111,97,100,101,114,46,115,115,223,80,158,36,52,83, +159,34,93,80,159,34,54,35,249,22,252,229,2,27,89,162,34,36,8,28,1, 25,100,101,102,97,117,108,116,45,108,111,97,100,47,117,115,101,45,99,111,109, -112,105,108,101,100,224,223,3,87,94,28,27,248,22,252,33,3,195,28,192,192, -28,248,22,252,143,1,195,27,248,22,252,53,3,196,28,192,192,248,22,252,54, -3,196,11,12,250,22,252,47,2,2,49,6,25,25,112,97,116,104,32,111,114, +112,105,108,101,100,224,223,3,87,94,28,27,248,22,252,34,3,195,28,192,192, +28,248,22,252,143,1,195,27,248,22,252,54,3,196,28,192,192,248,22,252,55, +3,196,11,12,250,22,252,48,2,2,49,6,25,25,112,97,116,104,32,111,114, 32,118,97,108,105,100,45,112,97,116,104,32,115,116,114,105,110,103,225,196,91, -159,40,11,90,161,35,34,11,28,248,22,252,55,3,200,199,27,247,22,252,97, -1,28,192,249,22,252,56,3,202,194,200,90,161,37,35,11,248,22,252,52,3, -193,90,161,35,38,11,28,249,22,252,18,2,195,2,209,64,115,97,109,101,226, -193,90,161,35,39,11,247,22,252,72,3,27,89,162,34,35,43,62,122,111,227, -225,7,5,3,250,22,252,49,3,196,198,249,80,159,41,36,35,197,5,3,46, -122,111,228,27,89,162,34,35,45,9,225,8,6,4,252,22,252,49,3,198,200, +159,40,11,90,161,35,34,11,28,248,22,252,56,3,200,199,27,247,22,252,97, +1,28,192,249,22,252,57,3,202,194,200,90,161,37,35,11,248,22,252,53,3, +193,90,161,35,38,11,28,249,22,252,19,2,195,2,209,64,115,97,109,101,226, +193,90,161,35,39,11,247,22,252,73,3,27,89,162,34,35,43,62,122,111,227, +225,7,5,3,250,22,252,50,3,196,198,249,80,159,41,36,35,197,5,3,46, +122,111,228,27,89,162,34,35,45,9,225,8,6,4,252,22,252,50,3,198,200, 2,164,247,22,252,227,1,249,80,159,43,36,35,199,80,158,43,52,27,27,80, -158,44,53,89,162,34,35,43,9,225,10,8,0,252,22,252,49,3,198,200,2, +158,44,53,89,162,34,35,43,9,225,10,8,0,252,22,252,50,3,198,200,2, 164,247,22,252,227,1,197,27,249,22,5,89,162,34,35,41,9,223,6,27,193, -27,250,22,252,65,3,196,11,32,229,89,162,8,44,34,34,9,222,11,28,192, +27,250,22,252,66,3,196,11,32,229,89,162,8,44,34,34,9,222,11,28,192, 249,22,57,195,194,11,203,27,27,28,195,27,249,22,5,89,162,34,35,41,9, -223,6,27,248,194,195,27,250,22,252,65,3,196,11,32,230,89,162,8,44,34, +223,6,27,248,194,195,27,250,22,252,66,3,196,11,32,230,89,162,8,44,34, 34,9,222,11,28,192,249,22,57,195,194,11,206,27,28,196,11,193,28,192,192, 28,193,28,196,28,249,22,192,248,22,59,196,248,22,59,199,193,11,11,11,11, -28,192,27,248,22,252,74,3,248,22,58,195,91,159,36,11,90,161,36,34,11, -248,195,248,22,48,248,22,252,217,1,248,22,252,38,3,249,80,159,55,36,35, -23,17,5,0,231,28,192,87,94,28,23,17,28,249,22,252,18,2,195,23,19, -12,248,22,252,194,2,249,22,252,135,2,248,22,252,172,1,251,22,252,191,1, +28,192,27,248,22,252,75,3,248,22,58,195,91,159,36,11,90,161,36,34,11, +248,195,248,22,48,248,22,252,217,1,248,22,252,39,3,249,80,159,55,36,35, +23,17,5,0,231,28,192,87,94,28,23,17,28,249,22,252,19,2,195,23,19, +12,248,22,252,195,2,249,22,252,136,2,248,22,252,172,1,251,22,252,191,1, 6,81,81,108,111,97,100,45,101,120,116,101,110,115,105,111,110,58,32,101,120, 112,101,99,116,101,100,32,109,111,100,117,108,101,32,100,101,99,108,97,114,97, 116,105,111,110,32,102,111,114,32,96,126,97,39,44,32,102,111,117,110,100,32, @@ -3799,33 +3805,33 @@ 101,99,108,97,114,97,116,105,111,110,32,102,111,114,32,96,126,97,39,233,203, 6,4,4,110,111,110,101,234,248,22,58,204,247,22,21,12,192,11,11,28,192, 249,80,159,47,8,48,35,203,194,27,28,196,27,249,22,5,89,162,34,35,41, -9,223,7,27,248,194,195,27,250,22,252,65,3,196,11,32,235,89,162,8,44, +9,223,7,27,248,194,195,27,250,22,252,66,3,196,11,32,235,89,162,8,44, 34,34,9,222,11,28,192,249,22,57,195,194,11,206,27,28,196,11,193,28,192, 192,28,193,28,196,28,249,22,192,248,22,59,196,248,22,59,199,193,11,11,11, 11,28,192,249,80,159,48,8,48,35,204,89,162,34,34,39,9,224,16,2,249, -247,22,252,75,3,248,22,58,195,195,27,28,198,27,249,22,5,89,162,34,35, -41,9,223,9,27,248,194,195,27,250,22,252,65,3,196,11,32,236,89,162,8, +247,22,252,76,3,248,22,58,195,195,27,28,198,27,249,22,5,89,162,34,35, +41,9,223,9,27,248,194,195,27,250,22,252,66,3,196,11,32,236,89,162,8, 44,34,34,9,222,11,28,192,249,22,57,195,194,11,23,15,27,28,197,11,193, 28,192,192,28,193,28,197,28,249,22,192,248,22,59,196,248,22,59,200,193,11, 11,11,11,28,192,249,80,159,49,8,48,35,205,89,162,34,34,39,9,224,17, 2,249,247,22,252,96,1,248,22,58,195,195,249,80,159,49,8,48,35,205,89, 162,34,34,38,9,224,17,9,249,247,22,252,96,1,194,195,192,32,237,89,162, 8,36,35,38,9,222,87,94,28,28,248,22,0,193,249,22,40,194,36,11,12, -250,22,252,47,2,2,45,6,19,19,112,114,111,99,101,100,117,114,101,32,40, +250,22,252,48,2,2,45,6,19,19,112,114,111,99,101,100,117,114,101,32,40, 97,114,105,116,121,32,50,41,238,195,192,83,159,34,93,80,159,34,55,35,89, -162,8,37,36,44,2,47,223,0,87,94,87,94,87,94,28,27,248,22,252,33, -3,195,28,192,192,28,248,22,252,143,1,195,27,248,22,252,53,3,196,28,192, -192,248,22,252,54,3,196,11,12,250,22,252,47,2,2,47,2,160,196,28,248, -22,252,53,3,194,12,248,22,252,194,2,249,22,252,138,2,248,22,252,172,1, +162,8,37,36,44,2,47,223,0,87,94,87,94,87,94,28,27,248,22,252,34, +3,195,28,192,192,28,248,22,252,143,1,195,27,248,22,252,54,3,196,28,192, +192,248,22,252,55,3,196,11,12,250,22,252,48,2,2,47,2,160,196,28,248, +22,252,54,3,194,12,248,22,252,195,2,249,22,252,139,2,248,22,252,172,1, 250,22,252,191,1,2,161,2,47,200,247,22,21,249,22,3,80,159,36,8,49, -35,196,27,247,22,252,71,3,251,32,239,89,162,8,64,38,49,2,218,222,28, -248,22,63,196,248,22,252,194,2,249,22,252,168,2,248,22,252,172,1,251,22, -252,191,1,2,219,2,47,28,248,22,63,203,201,250,22,1,22,252,49,3,204, -205,200,247,22,21,27,249,22,252,49,3,248,22,58,199,196,28,248,22,252,44, -3,193,27,250,22,1,22,252,49,3,196,199,28,248,22,252,44,3,193,192,251, +35,196,27,247,22,252,72,3,251,32,239,89,162,8,64,38,49,2,218,222,28, +248,22,63,196,248,22,252,195,2,249,22,252,169,2,248,22,252,172,1,251,22, +252,191,1,2,219,2,47,28,248,22,63,203,201,250,22,1,22,252,50,3,204, +205,200,247,22,21,27,249,22,252,50,3,248,22,58,199,196,28,248,22,252,45, +3,193,27,250,22,1,22,252,50,3,196,199,28,248,22,252,45,3,193,192,251, 2,239,198,199,200,248,22,59,202,251,2,239,197,198,199,248,22,59,201,196,198, 199,196,83,159,34,93,80,159,34,56,35,89,162,34,35,38,2,49,223,0,249, -247,80,158,36,54,195,11,248,22,252,11,3,32,240,89,162,8,36,35,35,1, +247,80,158,36,54,195,11,248,22,252,12,3,32,240,89,162,8,36,35,35,1, 20,100,101,102,97,117,108,116,45,114,101,97,100,101,114,45,103,117,97,114,100, 241,222,192,83,159,34,93,80,159,34,57,35,33,17,35,114,120,35,34,40,46, 43,63,41,47,43,40,46,42,41,34,242,83,159,34,93,80,159,34,58,35,2, @@ -3840,138 +3846,138 @@ 158,37,20,93,96,1,29,115,116,97,110,100,97,114,100,45,109,111,100,117,108, 101,45,110,97,109,101,45,114,101,115,111,108,118,101,114,246,89,162,8,36,35, 44,9,224,2,0,87,94,28,207,248,208,195,12,27,27,250,22,122,80,158,40, -8,26,248,22,252,98,3,247,22,252,219,2,11,28,192,192,27,247,22,116,87, -94,250,22,121,80,158,41,8,26,248,22,252,98,3,247,22,252,219,2,195,192, +8,26,248,22,252,99,3,247,22,252,220,2,11,28,192,192,27,247,22,116,87, +94,250,22,121,80,158,41,8,26,248,22,252,99,3,247,22,252,220,2,195,192, 250,22,121,195,198,66,97,116,116,97,99,104,247,89,162,34,37,42,9,223,1, 251,211,197,198,199,10,89,162,34,38,8,28,9,225,2,3,0,28,28,248,22, -56,196,249,22,252,18,2,248,22,58,198,66,112,108,97,110,101,116,248,11,87, +56,196,249,22,252,19,2,248,22,58,198,66,112,108,97,110,101,116,248,11,87, 94,28,207,12,20,14,159,80,158,36,41,250,80,158,39,42,249,22,25,11,80, -158,41,41,22,252,219,2,196,90,161,35,34,10,249,22,242,21,95,63,108,105, +158,41,41,22,252,220,2,196,90,161,35,34,10,249,22,242,21,95,63,108,105, 98,249,6,11,11,114,101,115,111,108,118,101,114,46,115,115,250,6,6,6,112, 108,97,110,101,116,251,1,27,112,108,97,110,101,116,45,109,111,100,117,108,101, 45,110,97,109,101,45,114,101,115,111,108,118,101,114,252,252,0,12,251,211,199, 200,201,202,27,28,248,22,252,143,1,197,27,248,80,159,39,8,50,35,199,27, 250,22,122,80,158,42,8,27,249,22,57,203,198,11,28,192,192,27,248,22,252, -218,1,200,28,249,22,252,81,3,2,243,194,27,249,22,252,80,3,2,242,195, -28,192,249,32,252,253,0,89,162,8,64,36,47,2,156,222,27,249,22,252,80, -3,2,242,196,28,192,27,249,22,252,49,3,196,27,248,22,84,197,28,249,22, +218,1,200,28,249,22,252,82,3,2,243,194,27,249,22,252,81,3,2,242,195, +28,192,249,32,252,253,0,89,162,8,64,36,47,2,156,222,27,249,22,252,81, +3,2,242,196,28,192,27,249,22,252,50,3,196,27,248,22,84,197,28,249,22, 252,201,1,194,5,1,46,252,254,0,2,226,28,249,22,252,201,1,194,5,2, -46,46,252,255,0,62,117,112,252,0,1,248,22,252,41,3,193,27,248,22,93, -195,27,249,22,252,80,3,2,242,195,28,192,249,2,252,253,0,249,22,252,49, +46,46,252,255,0,62,117,112,252,0,1,248,22,252,42,3,193,27,248,22,93, +195,27,249,22,252,81,3,2,242,195,28,192,249,2,252,253,0,249,22,252,50, 3,198,27,248,22,84,198,28,249,22,252,201,1,194,2,252,254,0,2,226,28, -249,22,252,201,1,194,2,252,255,0,2,252,0,1,248,22,252,41,3,193,248, -22,93,195,249,22,252,49,3,196,248,22,252,41,3,196,249,22,252,49,3,195, -248,22,252,41,3,197,249,22,252,49,3,199,27,248,22,84,198,28,249,22,252, +249,22,252,201,1,194,2,252,255,0,2,252,0,1,248,22,252,42,3,193,248, +22,93,195,249,22,252,50,3,196,248,22,252,42,3,196,249,22,252,50,3,195, +248,22,252,42,3,197,249,22,252,50,3,199,27,248,22,84,198,28,249,22,252, 201,1,194,2,252,254,0,2,226,28,249,22,252,201,1,194,2,252,255,0,2, -252,0,1,248,22,252,41,3,193,248,22,93,195,249,22,252,49,3,197,248,22, -252,41,3,196,248,22,65,249,22,252,166,1,6,72,72,32,40,114,101,108,97, +252,0,1,248,22,252,42,3,193,248,22,93,195,249,22,252,50,3,197,248,22, +252,42,3,196,248,22,65,249,22,252,166,1,6,72,72,32,40,114,101,108,97, 116,105,118,101,32,115,116,114,105,110,103,32,102,111,114,109,32,109,117,115,116, 32,99,111,110,116,97,105,110,32,111,110,108,121,32,97,45,122,44,32,65,45, 90,44,32,48,45,57,44,32,45,44,32,95,44,32,46,44,32,47,44,32,97, 110,100,32,252,1,1,6,37,37,115,112,97,99,101,44,32,119,105,116,104,32, 110,111,32,108,101,97,100,105,110,103,32,111,114,32,116,114,97,105,108,105,110, -103,32,47,41,252,2,1,28,248,22,252,33,3,197,28,248,22,252,54,3,197, +103,32,47,41,252,2,1,28,248,22,252,34,3,197,28,248,22,252,55,3,197, 196,248,22,65,6,25,25,40,97,32,112,97,116,104,32,109,117,115,116,32,98, 101,32,97,98,115,111,108,117,116,101,41,252,3,1,28,28,248,22,56,197,248, -22,252,16,2,248,22,64,198,10,11,28,249,22,252,18,2,248,22,58,199,2, -249,27,250,22,122,80,158,41,8,27,249,22,57,202,247,22,252,71,3,11,28, +22,252,17,2,248,22,64,198,10,11,28,249,22,252,19,2,248,22,58,199,2, +249,27,250,22,122,80,158,41,8,27,249,22,57,202,247,22,252,72,3,11,28, 192,192,27,27,248,22,70,200,28,249,22,188,194,36,248,22,65,6,5,5,109, 122,108,105,98,252,4,1,28,249,22,190,194,36,248,22,86,200,11,28,192,28, 249,22,4,32,252,5,1,89,162,34,35,36,9,222,28,248,22,252,143,1,193, -248,22,252,53,3,193,11,194,28,248,22,252,143,1,248,22,84,200,28,248,22, -252,53,3,248,22,84,200,27,27,248,22,58,195,27,248,22,59,196,27,247,22, -252,71,3,251,32,252,6,1,89,162,8,64,38,49,2,218,222,28,248,22,63, -196,248,22,252,194,2,249,22,252,168,2,248,22,252,172,1,251,22,252,191,1, -2,219,2,246,28,248,22,63,203,201,250,22,1,22,252,49,3,204,205,200,247, -22,21,27,249,22,252,49,3,248,22,58,199,196,28,248,22,252,44,3,193,27, -250,22,1,22,252,49,3,196,199,28,248,22,252,44,3,193,192,251,2,252,6, +248,22,252,54,3,193,11,194,28,248,22,252,143,1,248,22,84,200,28,248,22, +252,54,3,248,22,84,200,27,27,248,22,58,195,27,248,22,59,196,27,247,22, +252,72,3,251,32,252,6,1,89,162,8,64,38,49,2,218,222,28,248,22,63, +196,248,22,252,195,2,249,22,252,169,2,248,22,252,172,1,251,22,252,191,1, +2,219,2,246,28,248,22,63,203,201,250,22,1,22,252,50,3,204,205,200,247, +22,21,27,249,22,252,50,3,248,22,58,199,196,28,248,22,252,45,3,193,27, +250,22,1,22,252,50,3,196,199,28,248,22,252,45,3,193,192,251,2,252,6, 1,198,199,200,248,22,59,202,251,2,252,6,1,197,198,199,248,22,59,201,196, -198,197,196,249,22,252,49,3,194,248,22,84,202,11,11,11,11,28,249,22,252, -18,2,248,22,58,199,64,102,105,108,101,252,7,1,28,249,22,188,248,22,70, -199,36,27,248,22,84,198,28,248,22,252,143,1,193,28,27,248,22,252,33,3, -194,28,192,192,28,248,22,252,143,1,194,27,248,22,252,53,3,195,28,192,192, -248,22,252,54,3,195,11,249,22,252,56,3,194,248,80,159,41,8,50,35,201, -11,11,11,11,87,94,28,28,248,22,252,33,3,193,10,248,22,252,229,1,193, -12,28,198,250,22,252,46,2,67,114,101,113,117,105,114,101,252,8,1,249,22, +198,197,196,249,22,252,50,3,194,248,22,84,202,11,11,11,11,28,249,22,252, +19,2,248,22,58,199,64,102,105,108,101,252,7,1,28,249,22,188,248,22,70, +199,36,27,248,22,84,198,28,248,22,252,143,1,193,28,27,248,22,252,34,3, +194,28,192,192,28,248,22,252,143,1,194,27,248,22,252,54,3,195,28,192,192, +248,22,252,55,3,195,11,249,22,252,57,3,194,248,80,159,41,8,50,35,201, +11,11,11,11,87,94,28,28,248,22,252,34,3,193,10,248,22,252,229,1,193, +12,28,198,250,22,252,47,2,67,114,101,113,117,105,114,101,252,8,1,249,22, 252,191,1,6,17,17,98,97,100,32,109,111,100,117,108,101,32,112,97,116,104, 126,97,252,9,1,28,197,248,22,58,198,6,0,0,252,10,1,201,250,22,252, -47,2,2,246,249,22,252,191,1,6,13,13,109,111,100,117,108,101,32,112,97, +48,2,2,246,249,22,252,191,1,6,13,13,109,111,100,117,108,101,32,112,97, 116,104,126,97,252,11,1,28,197,248,22,58,198,6,0,0,252,12,1,199,27, -28,248,22,252,229,1,194,249,22,252,234,1,195,34,248,22,252,58,3,248,22, -252,59,3,195,27,28,248,22,252,229,1,195,249,22,252,234,1,196,35,248,80, +28,248,22,252,229,1,194,249,22,252,234,1,195,34,248,22,252,59,3,248,22, +252,60,3,195,27,28,248,22,252,229,1,195,249,22,252,234,1,196,35,248,80, 159,40,38,35,194,91,159,37,11,90,161,37,34,11,28,248,22,252,229,1,198, 250,22,7,67,105,103,110,111,114,101,100,252,13,1,249,22,252,234,1,202,36, -2,252,13,1,248,22,252,52,3,197,27,28,248,22,252,229,1,199,249,22,252, +2,252,13,1,248,22,252,53,3,197,27,28,248,22,252,229,1,199,249,22,252, 234,1,200,37,249,80,159,45,36,35,196,5,0,252,14,1,27,28,248,22,252, 229,1,200,249,22,252,234,1,201,38,249,22,252,191,1,6,3,3,44,126,97, -252,15,1,248,22,252,217,1,248,22,252,38,3,248,80,159,49,38,35,199,27, +252,15,1,248,22,252,217,1,248,22,252,39,3,248,80,159,49,38,35,199,27, 28,248,22,252,229,1,201,249,22,252,234,1,202,39,248,22,48,249,22,252,166, -1,196,248,22,252,217,1,248,22,252,38,3,199,27,28,248,22,252,229,1,202, -249,22,252,234,1,203,40,27,249,22,252,80,3,2,166,248,22,252,38,3,201, -28,192,248,22,58,193,10,27,27,250,22,122,80,158,51,8,26,248,22,252,98, -3,247,22,252,219,2,11,28,192,192,27,247,22,116,87,94,250,22,121,80,158, -52,8,26,248,22,252,98,3,247,22,252,219,2,195,192,87,95,28,23,17,27, -250,22,122,196,198,11,87,94,28,192,28,28,248,22,47,193,10,249,22,252,20, -2,196,194,12,252,22,252,44,2,2,246,6,71,71,109,111,100,117,108,101,32, +1,196,248,22,252,217,1,248,22,252,39,3,199,27,28,248,22,252,229,1,202, +249,22,252,234,1,203,40,27,249,22,252,81,3,2,166,248,22,252,39,3,201, +28,192,248,22,58,193,10,27,27,250,22,122,80,158,51,8,26,248,22,252,99, +3,247,22,252,220,2,11,28,192,192,27,247,22,116,87,94,250,22,121,80,158, +52,8,26,248,22,252,99,3,247,22,252,220,2,195,192,87,95,28,23,17,27, +250,22,122,196,198,11,87,94,28,192,28,28,248,22,47,193,10,249,22,252,21, +2,196,194,12,252,22,252,45,2,2,246,6,71,71,109,111,100,117,108,101,32, 112,114,101,118,105,111,117,115,108,121,32,108,111,97,100,101,100,32,119,105,116, 104,32,115,117,102,102,105,120,32,126,115,44,32,99,97,110,110,111,116,32,108, 111,97,100,32,119,105,116,104,32,115,117,102,102,105,120,32,126,115,58,32,126, -101,252,16,1,28,249,22,252,18,2,10,199,6,0,0,252,17,1,197,28,249, -22,252,18,2,10,201,6,0,0,252,18,1,199,23,15,12,28,192,12,87,95, -27,249,22,23,247,22,21,80,158,51,8,28,27,247,22,252,219,2,249,22,3, -89,162,34,35,48,9,226,13,14,2,3,28,249,22,252,20,2,248,22,59,199, -197,28,249,22,252,18,2,248,22,58,199,195,251,22,252,44,2,2,246,6,26, +101,252,16,1,28,249,22,252,19,2,10,199,6,0,0,252,17,1,197,28,249, +22,252,19,2,10,201,6,0,0,252,18,1,199,23,15,12,28,192,12,87,95, +27,249,22,23,247,22,21,80,158,51,8,28,27,247,22,252,220,2,249,22,3, +89,162,34,35,48,9,226,13,14,2,3,28,249,22,252,21,2,248,22,59,199, +197,28,249,22,252,19,2,248,22,58,199,195,251,22,252,45,2,2,246,6,26, 26,99,121,99,108,101,32,105,110,32,108,111,97,100,105,110,103,32,97,116,32, 126,101,58,32,126,101,252,19,1,198,249,22,2,22,59,248,22,73,249,22,57, 205,201,12,12,195,27,248,22,48,198,20,14,159,80,158,49,8,28,249,22,57, -247,22,252,219,2,204,20,14,159,80,158,49,41,250,80,158,52,42,249,22,25, +247,22,252,220,2,204,20,14,159,80,158,49,41,250,80,158,52,42,249,22,25, 11,80,158,54,41,22,241,195,249,247,80,158,51,54,205,248,22,48,248,22,252, -217,1,248,22,252,38,3,203,250,22,121,196,198,197,12,28,28,248,22,252,229, +217,1,248,22,252,39,3,203,250,22,121,196,198,197,12,28,28,248,22,252,229, 1,203,11,27,248,22,252,143,1,23,16,28,192,192,28,248,22,56,23,16,249, -22,252,18,2,248,22,58,23,18,2,249,11,250,22,121,80,158,50,8,27,28, +22,252,19,2,248,22,58,23,18,2,249,11,250,22,121,80,158,50,8,27,28, 248,22,252,143,1,23,18,249,22,57,23,19,248,80,159,53,8,50,35,23,21, -249,22,57,23,19,247,22,252,71,3,254,22,252,231,1,23,19,23,18,23,16, +249,22,57,23,19,247,22,252,72,3,254,22,252,231,1,23,19,23,18,23,16, 206,205,204,203,12,194,208,83,159,34,93,80,159,34,8,32,35,83,158,37,20, 93,95,2,69,89,162,34,34,36,9,223,0,248,80,158,35,8,32,9,89,162, -34,35,47,9,223,0,27,247,22,252,73,3,249,80,158,37,47,28,194,27,248, +34,35,47,9,223,0,27,247,22,252,74,3,249,80,158,37,47,28,194,27,248, 22,252,224,1,6,11,11,80,76,84,67,79,76,76,69,67,84,83,252,20,1, 28,192,192,6,0,0,252,21,1,6,0,0,252,22,1,27,28,195,250,22,252, -49,3,248,22,252,69,3,69,97,100,100,111,110,45,100,105,114,252,23,1,247, +50,3,248,22,252,70,3,69,97,100,100,111,110,45,100,105,114,252,23,1,247, 22,252,222,1,6,8,8,99,111,108,108,101,99,116,115,252,24,1,11,27,248, -80,159,40,8,51,35,249,22,71,201,248,22,65,248,22,252,69,3,72,99,111, +80,159,40,8,51,35,249,22,71,201,248,22,65,248,22,252,70,3,72,99,111, 108,108,101,99,116,115,45,100,105,114,252,25,1,28,193,249,22,57,195,194,192, 83,159,34,93,80,159,34,8,33,35,32,252,26,1,89,162,8,36,35,37,2, 71,222,27,248,22,252,11,1,194,28,192,192,248,22,252,12,1,194,83,159,34, 97,80,159,34,8,34,35,80,159,34,8,35,35,80,159,34,8,36,35,80,159, -34,8,37,35,80,159,34,8,38,35,26,9,22,252,98,2,63,101,118,116,252, -27,1,11,35,34,11,248,22,65,249,22,57,22,252,97,2,34,247,22,252,121, +34,8,37,35,80,159,34,8,38,35,26,9,22,252,99,2,63,101,118,116,252, +27,1,11,35,34,11,248,22,65,249,22,57,22,252,98,2,34,247,22,252,122, 2,11,21,93,34,83,159,34,93,80,159,34,8,39,35,89,162,34,35,39,2, 83,223,0,87,94,28,28,248,22,0,194,249,22,40,195,34,11,12,250,22,252, -47,2,2,83,6,19,19,112,114,111,99,101,100,117,114,101,32,40,97,114,105, +48,2,2,83,6,19,19,112,114,111,99,101,100,117,114,101,32,40,97,114,105, 116,121,32,48,41,252,28,1,196,248,80,158,35,8,35,89,162,34,35,36,9, 223,2,247,192,83,159,34,93,80,159,34,8,40,35,32,252,29,1,89,162,34, -35,38,2,85,222,87,94,28,248,22,252,5,3,193,12,250,22,252,47,2,2, -85,6,7,7,99,104,97,110,110,101,108,252,30,1,195,248,22,252,246,2,193, +35,38,2,85,222,87,94,28,248,22,252,6,3,193,12,250,22,252,48,2,2, +85,6,7,7,99,104,97,110,110,101,108,252,30,1,195,248,22,252,247,2,193, 83,159,34,93,80,159,34,8,41,35,32,252,31,1,89,162,34,35,38,2,87, -222,87,94,28,248,22,252,5,3,193,12,250,22,252,47,2,2,87,6,7,7, -99,104,97,110,110,101,108,252,32,1,195,249,22,252,247,2,34,194,83,159,34, +222,87,94,28,248,22,252,6,3,193,12,250,22,252,48,2,2,87,6,7,7, +99,104,97,110,110,101,108,252,32,1,195,249,22,252,248,2,34,194,83,159,34, 93,80,159,34,8,42,35,32,252,33,1,89,162,34,36,39,2,89,222,87,94, -28,248,22,252,5,3,193,12,250,22,252,47,2,2,89,6,7,7,99,104,97, -110,110,101,108,252,34,1,195,28,248,22,252,246,2,249,22,252,4,3,195,196, +28,248,22,252,6,3,193,12,250,22,252,48,2,2,89,6,7,7,99,104,97, +110,110,101,108,252,34,1,195,28,248,22,252,247,2,249,22,252,5,3,195,196, 12,11,83,159,34,93,80,159,34,8,43,35,32,252,35,1,89,162,34,34,34, -2,91,222,247,22,252,219,2,83,159,34,93,80,159,34,8,44,35,89,162,34, -35,39,2,93,223,0,87,94,28,249,22,188,195,39,12,250,22,252,47,2,2, +2,91,222,247,22,252,220,2,83,159,34,93,80,159,34,8,44,35,89,162,34, +35,39,2,93,223,0,87,94,28,249,22,188,195,39,12,250,22,252,48,2,2, 93,6,1,1,53,252,36,1,196,248,80,158,35,8,45,11,83,159,34,93,80, 159,34,8,46,35,89,162,34,35,39,2,97,223,0,87,94,28,249,22,188,195, -39,12,250,22,252,47,2,2,97,6,1,1,53,252,37,1,196,248,80,158,35, +39,12,250,22,252,48,2,2,97,6,1,1,53,252,37,1,196,248,80,158,35, 8,45,10,83,159,34,93,80,159,34,8,45,35,89,162,8,36,35,43,2,95, -223,0,27,248,22,252,197,2,65,101,109,112,116,121,252,38,1,27,247,22,252, -197,2,87,94,20,14,159,80,158,36,41,250,80,158,39,42,249,22,25,11,80, -158,41,41,22,252,219,2,196,87,96,249,22,246,194,66,35,37,114,53,114,115, +223,0,27,248,22,252,198,2,65,101,109,112,116,121,252,38,1,27,247,22,252, +198,2,87,94,20,14,159,80,158,36,41,250,80,158,39,42,249,22,25,11,80, +158,41,41,22,252,220,2,196,87,96,249,22,246,194,66,35,37,114,53,114,115, 252,39,1,248,22,244,2,252,39,1,248,22,245,21,95,64,111,110,108,121,252, 40,1,68,109,122,115,99,104,101,109,101,252,41,1,72,115,121,110,116,97,120, 45,114,117,108,101,115,252,42,1,28,195,12,249,22,3,32,252,43,1,89,162, -34,35,39,9,222,249,22,252,95,3,194,249,22,242,2,252,41,1,196,21,15, +34,35,39,9,222,249,22,252,96,3,194,249,22,242,2,252,41,1,196,21,15, 203,63,99,97,114,252,44,1,63,99,100,114,252,45,1,64,99,97,97,114,252, 46,1,64,99,97,100,114,252,47,1,64,99,100,97,114,252,48,1,64,99,100, 100,114,252,49,1,65,99,97,97,97,114,252,50,1,65,99,97,97,100,114,252, @@ -4092,7 +4098,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 13477); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,20,252,183,1,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,20,252,183,1,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,72,35,37,115,116, 120,109,122,45,98,111,100,121,1,29,2,11,11,18,95,11,37,98,35,10,34, 11,94,159,68,35,37,100,101,102,105,110,101,3,9,11,159,76,35,37,115,116, @@ -4105,7 +4111,7 @@ 1,11,16,1,2,5,34,35,93,16,5,93,2,5,89,162,34,35,46,9,223, 0,28,248,80,158,35,34,194,250,22,216,20,15,159,37,34,36,250,22,67,20, 15,159,40,35,36,249,22,216,201,249,22,65,20,15,159,44,36,36,68,109,122, -115,99,104,101,109,101,9,248,80,158,41,35,200,196,250,22,252,46,2,11,6, +115,99,104,101,109,101,9,248,80,158,41,35,200,196,250,22,252,47,2,11,6, 10,10,98,97,100,32,115,121,110,116,97,120,10,196,34,20,99,159,34,16,2, 30,11,65,35,37,115,116,120,12,69,115,116,120,45,112,97,105,114,63,13,11, 30,14,2,12,67,115,116,120,45,99,100,114,15,6,16,3,18,98,64,104,101, @@ -4117,7 +4123,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 451); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,95,252,202,6,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,95,252,202,6,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,68,109,122,115,99, 104,101,109,101,1,29,2,11,11,10,10,10,34,80,158,34,34,20,99,159,34, 16,0,16,0,74,35,37,109,111,100,117,108,101,45,98,101,103,105,110,3,10, @@ -4152,80 +4158,80 @@ 45,101,118,97,108,45,112,114,105,110,116,45,108,111,111,112,33,1,25,115,99, 104,101,109,101,45,114,101,112,111,114,116,45,101,110,118,105,114,111,110,109,101, 110,116,34,64,108,101,116,42,35,77,117,110,115,121,110,116,97,120,45,115,112, -108,105,99,105,110,103,36,76,98,101,103,105,110,45,102,111,114,45,115,121,110, -116,97,120,37,62,111,114,38,2,3,79,109,101,109,111,114,121,45,116,114,97, -99,101,45,108,97,109,98,100,97,39,71,119,105,116,104,45,115,121,110,116,97, -120,40,63,108,101,116,41,1,28,109,122,115,99,104,101,109,101,45,105,110,45, -115,116,120,45,109,111,100,117,108,101,45,98,101,103,105,110,42,63,97,110,100, -43,71,115,121,110,116,97,120,45,99,97,115,101,44,70,115,121,110,116,97,120, -47,108,111,99,45,77,100,101,102,105,110,101,45,102,111,114,45,115,121,110,116, -97,120,46,66,108,101,116,47,101,99,47,69,102,108,117,105,100,45,108,101,116, -48,78,112,97,114,97,109,101,116,101,114,105,122,101,45,98,114,101,97,107,49, -70,108,101,116,45,115,121,110,116,97,120,50,66,115,121,110,116,97,120,51,66, -108,101,116,114,101,99,52,75,113,117,97,115,105,115,121,110,116,97,120,47,108, -111,99,53,64,99,111,110,100,54,62,100,111,55,64,119,104,101,110,56,66,117, -110,108,101,115,115,57,73,100,101,102,105,110,101,45,115,116,114,117,99,116,58, -64,99,97,115,101,59,65,100,101,108,97,121,60,75,108,101,116,114,101,99,45, -115,121,110,116,97,120,101,115,61,73,108,101,116,114,101,99,45,115,121,110,116, -97,120,62,72,108,101,116,45,115,121,110,116,97,120,101,115,63,72,115,121,110, -116,97,120,45,114,117,108,101,115,64,75,115,121,110,116,97,120,45,105,100,45, -114,117,108,101,115,65,72,112,97,114,97,109,101,116,101,114,105,122,101,66,72, -115,121,110,116,97,120,45,99,97,115,101,42,67,73,119,105,116,104,45,104,97, -110,100,108,101,114,115,68,74,119,105,116,104,45,104,97,110,100,108,101,114,115, -42,69,71,115,101,116,33,45,118,97,108,117,101,115,70,70,108,101,116,45,115, -116,114,117,99,116,71,66,108,101,116,47,99,99,72,64,116,105,109,101,73,73, -100,101,102,105,110,101,45,115,121,110,116,97,120,74,70,113,117,97,115,105,113, -117,111,116,101,75,68,117,110,115,121,110,116,97,120,76,71,113,117,97,115,105, -115,121,110,116,97,120,77,66,100,101,102,105,110,101,78,16,76,73,35,37,109, +108,105,99,105,110,103,36,71,115,121,110,116,97,120,45,99,97,115,101,37,66, +100,101,102,105,110,101,38,62,111,114,39,2,3,63,108,101,116,40,1,28,109, +122,115,99,104,101,109,101,45,105,110,45,115,116,120,45,109,111,100,117,108,101, +45,98,101,103,105,110,41,71,115,101,116,33,45,118,97,108,117,101,115,42,63, +97,110,100,43,62,100,111,44,76,98,101,103,105,110,45,102,111,114,45,115,121, +110,116,97,120,45,66,108,101,116,47,101,99,46,79,109,101,109,111,114,121,45, +116,114,97,99,101,45,108,97,109,98,100,97,47,66,115,121,110,116,97,120,48, +70,108,101,116,45,115,116,114,117,99,116,49,65,100,101,108,97,121,50,70,115, +121,110,116,97,120,47,108,111,99,51,66,108,101,116,47,99,99,52,66,108,101, +116,114,101,99,53,64,119,104,101,110,54,64,99,111,110,100,55,64,116,105,109, +101,56,66,117,110,108,101,115,115,57,73,100,101,102,105,110,101,45,115,116,114, +117,99,116,58,75,113,117,97,115,105,115,121,110,116,97,120,47,108,111,99,59, +71,119,105,116,104,45,115,121,110,116,97,120,60,70,108,101,116,45,115,121,110, +116,97,120,61,77,100,101,102,105,110,101,45,102,111,114,45,115,121,110,116,97, +120,62,75,108,101,116,114,101,99,45,115,121,110,116,97,120,101,115,63,73,108, +101,116,114,101,99,45,115,121,110,116,97,120,64,72,108,101,116,45,115,121,110, +116,97,120,101,115,65,72,115,121,110,116,97,120,45,114,117,108,101,115,66,75, +115,121,110,116,97,120,45,105,100,45,114,117,108,101,115,67,72,112,97,114,97, +109,101,116,101,114,105,122,101,68,73,119,105,116,104,45,104,97,110,100,108,101, +114,115,69,78,112,97,114,97,109,101,116,101,114,105,122,101,45,98,114,101,97, +107,70,72,115,121,110,116,97,120,45,99,97,115,101,42,71,74,119,105,116,104, +45,104,97,110,100,108,101,114,115,42,72,69,102,108,117,105,100,45,108,101,116, +73,64,99,97,115,101,74,73,100,101,102,105,110,101,45,115,121,110,116,97,120, +75,70,113,117,97,115,105,113,117,111,116,101,76,68,117,110,115,121,110,116,97, +120,77,71,113,117,97,115,105,115,121,110,116,97,120,78,16,76,73,35,37,109, 111,114,101,45,115,99,104,101,109,101,79,2,79,66,35,37,109,105,115,99,80, 2,80,2,80,76,35,37,115,116,120,99,97,115,101,45,115,99,104,101,109,101, 81,2,80,2,79,2,80,2,79,2,80,2,80,2,79,70,35,37,119,105,116, 104,45,115,116,120,82,2,80,65,35,37,115,116,120,83,2,80,2,80,2,80, 2,80,2,80,2,80,2,80,2,80,2,80,2,80,2,80,2,79,2,80,2, 80,2,80,71,35,37,113,113,45,97,110,100,45,111,114,84,67,35,37,113,113, -115,116,120,85,68,35,37,100,101,102,105,110,101,86,2,84,68,35,37,107,101, -114,110,101,108,87,2,80,2,82,2,84,72,35,37,115,116,120,109,122,45,98, -111,100,121,88,2,84,68,35,37,115,116,120,108,111,99,89,2,89,2,86,74, -35,37,100,101,102,105,110,101,45,101,116,45,97,108,90,2,79,2,79,2,81, -69,35,37,115,116,120,99,97,115,101,91,2,84,2,85,66,35,37,99,111,110, -100,92,2,79,2,90,2,90,2,90,2,79,2,79,2,81,2,81,2,81,2, -81,2,81,2,79,2,89,2,79,2,79,2,79,2,79,2,79,2,79,2,86, -2,84,2,85,2,85,2,86,16,76,2,4,2,5,2,6,2,7,2,8,2, +115,116,120,85,68,35,37,115,116,120,108,111,99,86,68,35,37,100,101,102,105, +110,101,87,2,84,68,35,37,107,101,114,110,101,108,88,2,84,72,35,37,115, +116,120,109,122,45,98,111,100,121,89,2,79,2,84,2,79,2,87,74,35,37, +100,101,102,105,110,101,45,101,116,45,97,108,90,2,80,69,35,37,115,116,120, +99,97,115,101,91,2,79,2,79,2,86,2,79,2,84,2,90,66,35,37,99, +111,110,100,92,2,79,2,90,2,90,2,85,2,82,2,81,2,87,2,81,2, +81,2,81,2,81,2,81,2,79,2,79,2,79,2,86,2,79,2,79,2,79, +2,87,2,84,2,85,2,85,16,76,2,4,2,5,2,6,2,7,2,8,2, 9,2,10,2,11,2,12,2,13,2,14,2,15,2,16,2,17,2,18,2,19, 2,20,2,21,2,22,2,23,2,24,2,25,2,26,2,27,2,28,2,29,2, -30,2,31,2,32,2,33,2,34,2,35,2,36,2,37,2,38,1,20,35,37, -112,108,97,105,110,45,109,111,100,117,108,101,45,98,101,103,105,110,93,2,39, -2,40,2,41,2,3,2,43,2,44,2,45,2,46,2,47,2,48,2,49,2, +30,2,31,2,32,2,33,2,34,2,35,2,36,2,37,2,38,2,39,1,20, +35,37,112,108,97,105,110,45,109,111,100,117,108,101,45,98,101,103,105,110,93, +2,40,2,3,2,42,2,43,2,44,2,45,2,46,2,47,2,48,2,49,2, 50,2,51,2,52,2,53,2,54,2,55,2,56,2,57,2,58,2,59,2,60, 2,61,2,62,2,63,2,64,2,65,2,66,2,67,2,68,2,69,2,70,2, 71,2,72,2,73,2,74,2,75,2,76,2,77,2,78,8,31,8,76,9,9, -101,2,87,2,79,2,80,2,81,2,83,2,88,2,85,2,86,68,35,37,101, +101,2,88,2,79,2,80,2,81,2,83,2,89,2,85,2,87,68,35,37,101, 120,112,111,98,115,94,9,0}; EVAL_ONE_SIZED_STR((char *)expr, 1750); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,134,252,16,13,159,34,20,99,159,34,16,1,20, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,134,252,16,13,159,34,20,99,159,34,16,1,20, 24,65,98,101,103,105,110,0,16,0,83,158,41,20,96,114,66,35,37,114,53, 114,115,1,29,2,11,11,10,10,10,35,80,158,34,34,20,99,159,34,16,1, 30,3,2,2,69,117,110,100,101,102,105,110,101,100,4,254,1,16,0,11,11, -16,1,2,4,35,11,16,24,64,108,101,116,42,5,73,100,101,102,105,110,101, -45,115,121,110,116,97,120,6,70,108,101,116,45,115,121,110,116,97,120,7,66, -108,97,109,98,100,97,8,73,108,101,116,114,101,99,45,115,121,110,116,97,120, -9,63,97,110,100,10,2,0,64,99,111,110,100,11,62,111,114,12,71,114,53, -114,115,58,108,101,116,114,101,99,13,62,100,111,14,65,35,37,97,112,112,15, -67,35,37,100,97,116,117,109,16,63,108,101,116,17,65,100,101,108,97,121,18, -67,117,110,113,117,111,116,101,19,76,117,110,113,117,111,116,101,45,115,112,108, -105,99,105,110,103,20,65,113,117,111,116,101,21,64,99,97,115,101,22,70,113, -117,97,115,105,113,117,111,116,101,23,62,105,102,24,66,100,101,102,105,110,101, -25,64,115,101,116,33,26,65,35,37,116,111,112,27,16,24,71,35,37,113,113, -45,97,110,100,45,111,114,28,68,35,37,100,101,102,105,110,101,29,76,35,37, -115,116,120,99,97,115,101,45,115,99,104,101,109,101,30,68,35,37,107,101,114, -110,101,108,31,2,30,2,28,2,31,66,35,37,99,111,110,100,32,2,28,11, -73,35,37,109,111,114,101,45,115,99,104,101,109,101,33,2,31,2,31,2,28, -2,33,2,31,2,31,2,31,2,33,2,28,2,31,2,29,2,31,2,31,16, -24,2,5,2,6,2,7,2,8,2,9,2,10,2,0,2,11,2,12,66,108, -101,116,114,101,99,34,2,14,2,15,2,16,2,17,2,18,2,19,2,20,2, -21,2,22,2,23,2,24,2,25,2,26,2,27,34,58,93,16,5,93,2,13, +16,1,2,4,35,11,16,24,65,35,37,97,112,112,5,64,108,101,116,42,6, +66,100,101,102,105,110,101,7,73,108,101,116,114,101,99,45,115,121,110,116,97, +120,8,70,108,101,116,45,115,121,110,116,97,120,9,63,97,110,100,10,2,0, +64,99,111,110,100,11,62,111,114,12,65,113,117,111,116,101,13,64,99,97,115, +101,14,67,35,37,100,97,116,117,109,15,63,108,101,116,16,67,117,110,113,117, +111,116,101,17,76,117,110,113,117,111,116,101,45,115,112,108,105,99,105,110,103, +18,65,100,101,108,97,121,19,73,100,101,102,105,110,101,45,115,121,110,116,97, +120,20,66,108,97,109,98,100,97,21,70,113,117,97,115,105,113,117,111,116,101, +22,62,105,102,23,62,100,111,24,71,114,53,114,115,58,108,101,116,114,101,99, +25,64,115,101,116,33,26,65,35,37,116,111,112,27,16,24,68,35,37,107,101, +114,110,101,108,28,71,35,37,113,113,45,97,110,100,45,111,114,29,68,35,37, +100,101,102,105,110,101,30,76,35,37,115,116,120,99,97,115,101,45,115,99,104, +101,109,101,31,2,31,2,29,2,28,66,35,37,99,111,110,100,32,2,29,2, +28,73,35,37,109,111,114,101,45,115,99,104,101,109,101,33,2,28,2,29,2, +28,2,28,2,33,2,30,2,28,2,29,2,28,2,33,11,2,28,2,28,16, +24,2,5,2,6,2,7,2,8,2,9,2,10,2,0,2,11,2,12,2,13, +2,14,2,15,2,16,2,17,2,18,2,19,2,20,2,21,2,22,2,23,2, +24,66,108,101,116,114,101,99,34,2,26,2,27,34,58,93,16,5,93,2,25, 87,98,83,159,34,93,80,159,34,8,30,35,89,162,35,35,41,9,223,0,251, 80,158,38,46,20,15,159,38,44,47,21,94,3,1,4,103,57,53,50,35,3, 1,4,103,57,53,49,36,248,22,58,198,248,22,84,198,83,159,34,93,80,159, @@ -4253,12 +4259,12 @@ 11,3,252,80,158,40,46,20,15,159,40,34,47,21,95,3,1,4,103,57,52, 48,44,3,1,4,103,57,51,57,45,3,1,4,103,57,51,56,46,248,22,86, 198,250,22,2,80,159,43,8,26,35,248,22,86,201,248,22,58,201,248,22,84, -198,21,99,2,13,6,19,19,103,101,110,101,114,97,116,101,95,116,101,109,112, +198,21,99,2,25,6,19,19,103,101,110,101,114,97,116,101,95,116,101,109,112, 95,110,97,109,101,115,47,94,64,118,97,114,49,48,63,46,46,46,49,9,94, 94,2,48,65,105,110,105,116,49,50,2,49,64,98,111,100,121,51,2,49,20, 15,159,45,36,47,27,28,248,80,158,37,34,196,249,80,158,38,35,248,80,158, 39,36,198,27,248,80,158,40,37,199,28,248,80,158,40,34,193,28,27,248,80, -158,41,36,194,28,249,22,252,20,2,6,19,19,103,101,110,101,114,97,116,101, +158,41,36,194,28,249,22,252,21,2,6,19,19,103,101,110,101,114,97,116,101, 95,116,101,109,112,95,110,97,109,101,115,52,248,22,217,195,9,11,27,248,80, 158,41,37,194,28,248,80,158,41,34,193,28,248,80,158,41,41,248,80,158,42, 36,194,27,248,80,158,42,37,194,28,248,80,158,42,34,193,249,80,158,43,38, @@ -4273,17 +4279,17 @@ 80,158,48,37,196,28,248,80,158,48,39,193,248,80,158,48,42,193,11,11,11, 11,11,11,11,11,28,192,27,248,22,58,194,27,248,22,84,195,27,248,22,93, 196,27,248,22,96,197,27,248,22,95,198,249,80,158,43,44,202,27,251,22,67, -200,201,199,202,250,80,158,47,45,89,162,34,34,47,9,224,13,3,252,80,158, +202,201,200,199,250,80,158,47,45,89,162,34,34,47,9,224,13,3,252,80,158, 40,46,20,15,159,40,37,47,21,95,3,1,4,103,57,52,57,53,3,1,4, 103,57,52,56,54,3,1,4,103,57,52,55,55,249,22,2,80,159,42,8,27, -35,248,22,84,200,250,22,2,80,159,43,8,28,35,248,22,94,201,248,22,58, -201,249,22,71,250,22,2,80,159,45,8,29,35,248,22,84,203,248,22,94,203, +35,248,22,84,200,250,22,2,80,159,43,8,28,35,248,22,58,201,248,22,93, +201,249,22,71,250,22,2,80,159,45,8,29,35,248,22,84,203,248,22,58,203, 250,80,158,45,46,20,15,159,45,41,47,21,93,3,1,4,103,57,52,52,56, -248,22,93,203,21,95,2,17,94,94,2,48,2,4,2,49,97,2,17,94,94, +248,22,94,203,21,95,2,16,94,94,2,48,2,4,2,49,97,2,16,94,94, 65,116,101,109,112,49,57,2,50,2,49,95,2,26,2,48,2,57,2,49,96, -2,17,9,2,51,2,49,20,15,159,47,42,47,27,28,248,80,158,38,34,197, +2,16,9,2,51,2,49,20,15,159,47,42,47,27,28,248,80,158,38,34,197, 249,80,158,39,35,248,80,158,40,36,199,27,248,80,158,41,37,200,28,248,80, -158,41,34,193,28,27,248,80,158,42,36,194,28,249,22,252,20,2,6,19,19, +158,41,34,193,28,27,248,80,158,42,36,194,28,249,22,252,21,2,6,19,19, 103,101,110,101,114,97,116,101,95,116,101,109,112,95,110,97,109,101,115,58,248, 22,217,195,9,11,27,248,80,158,42,37,194,28,248,80,158,42,34,193,249,80, 158,43,38,27,248,80,158,45,36,196,28,248,80,158,45,34,193,249,80,158,46, @@ -4301,14 +4307,14 @@ 248,80,158,51,42,193,11,11,11,11,11,11,11,28,192,27,248,22,58,194,27, 248,22,84,195,27,248,22,93,196,27,248,22,96,197,27,249,22,76,199,38,27, 249,22,76,200,39,27,249,22,75,201,40,249,80,158,46,44,205,27,252,22,67, -204,201,202,203,200,250,80,158,50,45,89,162,34,34,46,9,224,16,3,253,80, +204,200,202,201,203,250,80,158,50,45,89,162,34,34,46,9,224,16,3,253,80, 158,41,46,20,15,159,41,43,47,21,96,3,1,4,103,57,53,53,59,3,1, 4,103,57,53,48,60,3,1,4,103,57,53,52,61,3,1,4,103,57,53,51, -62,248,22,58,199,248,22,96,199,250,22,2,80,159,44,8,30,35,248,22,93, -202,248,22,84,202,248,22,95,199,21,99,2,13,6,19,19,103,101,110,101,114, +62,248,22,58,199,248,22,95,199,250,22,2,80,159,44,8,30,35,248,22,93, +202,248,22,96,202,248,22,84,199,21,99,2,25,6,19,19,103,101,110,101,114, 97,116,101,95,116,101,109,112,95,110,97,109,101,115,63,94,61,121,64,2,49, 95,67,110,101,119,116,101,109,112,65,64,116,101,109,112,66,2,49,94,94,2, -48,2,50,2,49,2,51,2,49,20,15,159,50,45,47,250,22,252,46,2,11, +48,2,50,2,49,2,51,2,49,20,15,159,50,45,47,250,22,252,47,2,11, 6,10,10,98,97,100,32,115,121,110,116,97,120,67,199,34,20,99,159,39,16, 13,30,68,65,35,37,115,116,120,69,69,115,116,120,45,112,97,105,114,63,70, 11,30,71,2,69,67,99,111,110,115,47,35,102,72,1,30,73,2,69,67,115, @@ -4322,30 +4328,30 @@ 0,30,92,69,35,37,115,116,120,99,97,115,101,93,1,20,99,97,116,99,104, 45,101,108,108,105,112,115,105,115,45,101,114,114,111,114,94,1,30,95,2,93, 1,24,97,112,112,108,121,45,112,97,116,116,101,114,110,45,115,117,98,115,116, -105,116,117,116,101,96,0,16,12,18,158,164,39,99,2,13,41,98,39,10,34, -11,93,159,68,109,122,115,99,104,101,109,101,97,9,11,16,4,2,4,2,2, -2,13,2,2,98,38,10,35,11,93,159,2,97,9,11,16,0,96,37,8,254, +105,116,117,116,101,96,0,16,12,18,158,164,39,99,2,25,41,98,39,10,34, +11,93,159,68,109,122,115,99,104,101,109,101,97,9,11,16,4,2,25,2,2, +2,4,2,2,98,38,10,35,11,93,159,2,97,9,11,16,0,96,37,8,254, 1,11,16,0,16,8,36,11,3,1,4,103,57,51,51,98,3,1,4,103,57, 51,52,99,3,1,4,103,57,51,53,100,3,1,7,101,110,118,52,56,49,52, 101,2,101,2,101,16,8,35,11,2,48,2,50,2,51,3,1,7,101,110,118, 52,56,49,53,102,2,102,2,102,158,2,47,41,158,2,44,41,158,9,41,158, 2,45,41,2,46,41,41,18,158,95,10,2,42,2,43,41,18,16,2,96,2, 49,43,93,8,252,233,15,16,4,42,11,61,114,103,3,1,7,101,110,118,52, -56,50,53,104,95,9,8,252,233,15,2,93,18,158,95,99,2,17,46,39,38, +56,50,53,104,95,9,8,252,233,15,2,93,18,158,95,99,2,16,46,39,38, 37,16,10,45,11,3,1,4,103,57,50,56,105,3,1,4,103,57,50,57,106, 3,1,4,103,57,51,48,107,3,1,4,103,57,51,49,108,3,1,7,101,110, 118,52,56,52,51,109,2,109,2,109,2,109,16,10,44,11,2,57,2,48,2, 50,2,51,3,1,7,101,110,118,52,56,52,52,110,2,110,2,110,2,110,158, -2,53,46,158,160,10,2,17,2,54,2,55,46,46,18,158,95,10,2,41,2, +2,53,46,158,160,10,2,16,2,54,2,55,46,46,18,158,95,10,2,41,2, 4,46,18,158,95,10,2,39,2,40,46,18,158,96,10,2,26,2,37,2,38, -46,18,16,2,103,93,158,160,10,2,17,9,2,56,46,54,98,53,10,34,11, +46,18,16,2,103,93,158,160,10,2,16,9,2,56,46,54,98,53,10,34,11, 95,159,68,35,37,112,97,114,97,109,122,111,9,11,159,74,35,37,115,109,97, -108,108,45,115,99,104,101,109,101,112,9,11,159,2,69,9,11,16,14,1,26, -100,97,116,117,109,45,62,115,121,110,116,97,120,45,111,98,106,101,99,116,47, -115,104,97,112,101,113,29,114,11,11,78,112,97,116,116,101,114,110,45,115,117, -98,115,116,105,116,117,116,101,115,2,114,2,96,2,114,73,115,121,110,116,97, -120,45,99,97,115,101,42,42,116,2,114,2,94,2,114,66,115,121,110,116,97, -120,117,2,114,75,115,117,98,115,116,105,116,117,116,101,45,115,116,111,112,118, +108,108,45,115,99,104,101,109,101,112,9,11,159,2,69,9,11,16,14,66,115, +121,110,116,97,120,113,29,114,11,11,73,115,121,110,116,97,120,45,99,97,115, +101,42,42,115,2,114,2,94,2,114,78,112,97,116,116,101,114,110,45,115,117, +98,115,116,105,116,117,116,101,116,2,114,1,26,100,97,116,117,109,45,62,115, +121,110,116,97,120,45,111,98,106,101,99,116,47,115,104,97,112,101,117,2,114, +2,96,2,114,75,115,117,98,115,116,105,116,117,116,101,45,115,116,111,112,118, 2,114,98,52,10,35,11,95,159,64,35,37,115,99,119,9,11,159,2,112,9, 11,159,2,69,9,11,16,0,96,51,8,254,1,11,16,0,16,4,50,11,61, 120,120,3,1,6,101,110,118,52,53,52,121,16,4,49,11,68,104,101,114,101, @@ -4353,7 +4359,7 @@ 2,123,13,16,4,35,2,114,2,93,11,93,8,252,241,15,16,4,47,11,2, 103,3,1,7,101,110,118,52,56,53,54,124,95,9,8,252,241,15,2,93,18, 16,2,96,2,49,56,93,8,252,241,15,16,4,55,11,2,103,2,124,95,9, -8,252,241,15,2,93,18,158,164,39,99,2,13,59,39,38,37,16,14,58,11, +8,252,241,15,2,93,18,158,164,39,99,2,25,59,39,38,37,16,14,58,11, 3,1,4,103,57,50,49,125,3,1,4,103,57,50,50,126,3,1,4,103,57, 50,51,127,3,1,4,103,57,50,52,128,3,1,4,103,57,50,53,129,3,1, 4,103,57,50,54,130,3,1,7,101,110,118,52,56,56,48,131,2,131,2,131, @@ -4367,7 +4373,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 3356); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,5,89,159,34,20,99,159,34,16,1,20,24,65, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,5,89,159,34,20,99,159,34,16,1,20,24,65, 98,101,103,105,110,0,16,0,83,160,42,80,158,34,34,34,18,158,94,96,67, 114,101,113,117,105,114,101,1,36,10,11,158,96,10,64,111,110,108,121,2,68, 109,122,115,99,104,101,109,101,3,1,22,110,97,109,101,115,112,97,99,101,45, @@ -4375,7 +4381,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 99); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,3,74,159,35,20,99,159,34,16,1,20,24,65, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,3,74,159,35,20,99,159,34,16,1,20,24,65, 98,101,103,105,110,0,16,0,87,94,248,22,248,68,109,122,115,99,104,101,109, 101,1,83,160,42,80,158,34,34,35,18,158,94,96,78,114,101,113,117,105,114, 101,45,102,111,114,45,115,121,110,116,97,120,2,36,10,11,158,2,1,36,36, @@ -4383,9 +4389,9 @@ EVAL_ONE_SIZED_STR((char *)expr, 84); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,48,46,50,2,67,159,38,20,99,159,34,16,0,16,0,248, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,5,51,54,57,46,49,2,67,159,38,20,99,159,34,16,0,16,0,248, 22,240,248,249,22,242,66,35,37,109,105,115,99,0,1,34,109,97,107,101,45, 115,116,97,110,100,97,114,100,45,109,111,100,117,108,101,45,110,97,109,101,45, -114,101,115,111,108,118,101,114,1,247,22,252,219,2,0}; +114,101,115,111,108,118,101,114,1,247,22,252,220,2,0}; EVAL_ONE_SIZED_STR((char *)expr, 77); } diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 2597a839cf..4a229e6870 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -188,6 +188,9 @@ static void finish_expstart_module(Scheme_Env *menv, Scheme_Env *env, int with_t static void finish_expstart_module_in_namespace(Scheme_Env *menv, Scheme_Env *env); static void eval_module_body(Scheme_Env *menv); +static Scheme_Object *do_namespace_require(Scheme_Env *env, int argc, Scheme_Object *argv[], + int for_exp, int copy, int etonly); + static Scheme_Object *default_module_resolver(int argc, Scheme_Object **argv); static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Object **exss, char *exps, @@ -835,11 +838,30 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[], if (i < srcm->me->num_var_provides) { break; } else { - if (fail_with_error) - scheme_raise_exn(MZEXN_FAIL_CONTRACT, - "%s: name is provided as syntax: %V by module: %V", - errname, - name, srcm->modname); + if (fail_with_error) { + if (!phase) { + /* Evaluate id in a fresh namespace */ + Scheme_Object *a[3], *ns; + start_module(m, env, 0, modidx, 1, 0, scheme_null); + a[0] = scheme_intern_symbol("empty"); + ns = scheme_make_namespace(1, a); + a[0] = (Scheme_Object *)env; + a[1] = srcm->modname; + a[2] = ns; + namespace_attach_module(3, a); + a[0] = scheme_make_pair(scheme_intern_symbol("only"), + scheme_make_pair(srcm->modname, + scheme_make_pair(name, + scheme_null))); + do_namespace_require((Scheme_Env *)ns, 1, a, 0, 0, 0); + return scheme_eval(name, (Scheme_Env *)ns); + } else { + scheme_raise_exn(MZEXN_FAIL_CONTRACT, + "%s: name is provided as syntax: %V by module: %V", + errname, + name, srcm->modname); + } + } return NULL; } } @@ -956,12 +978,13 @@ static Scheme_Object *dynamic_require_for_syntax(int argc, Scheme_Object *argv[] return _dynamic_require(argc, argv, scheme_get_env(NULL), 0, 1, 0, 0, 1, -1); } -static Scheme_Object *do_namespace_require(int argc, Scheme_Object *argv[], int for_exp, int copy, int etonly) +static Scheme_Object *do_namespace_require(Scheme_Env *env, int argc, Scheme_Object *argv[], + int for_exp, int copy, int etonly) { Scheme_Object *form, *rn, *brn; - Scheme_Env *env; - env = scheme_get_env(NULL); + if (!env) + env = scheme_get_env(NULL); if (for_exp) { scheme_prepare_exp_env(env); env = env->exp_env; @@ -989,22 +1012,22 @@ static Scheme_Object *do_namespace_require(int argc, Scheme_Object *argv[], int static Scheme_Object *namespace_require(int argc, Scheme_Object *argv[]) { - return do_namespace_require(argc, argv, 0, 0, 0); + return do_namespace_require(NULL, argc, argv, 0, 0, 0); } static Scheme_Object *namespace_trans_require(int argc, Scheme_Object *argv[]) { - return do_namespace_require(argc, argv, 1, 0, 0); + return do_namespace_require(NULL, argc, argv, 1, 0, 0); } static Scheme_Object *namespace_require_copy(int argc, Scheme_Object *argv[]) { - return do_namespace_require(argc, argv, 0, 1, 0); + return do_namespace_require(NULL, argc, argv, 0, 1, 0); } static Scheme_Object *namespace_require_etonly(int argc, Scheme_Object *argv[]) { - return do_namespace_require(argc, argv, 0, 0, 1); + return do_namespace_require(NULL, argc, argv, 0, 0, 1); } static Scheme_Object *namespace_attach_module(int argc, Scheme_Object *argv[]) diff --git a/src/mzscheme/src/schminc.h b/src/mzscheme/src/schminc.h index 884dc5f0bd..2abe213d2a 100644 --- a/src/mzscheme/src/schminc.h +++ b/src/mzscheme/src/schminc.h @@ -13,7 +13,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 884 +#define EXPECTED_PRIM_COUNT 885 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index e904b83de9..8330f24785 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -8,7 +8,7 @@ #endif -#define MZSCHEME_VERSION_MAJOR 360 -#define MZSCHEME_VERSION_MINOR 2 +#define MZSCHEME_VERSION_MAJOR 369 +#define MZSCHEME_VERSION_MINOR 1 -#define MZSCHEME_VERSION "360.2" _MZ_SPECIAL_TAG +#define MZSCHEME_VERSION "369.1" _MZ_SPECIAL_TAG diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 2c5a492504..62fda10b7e 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -133,7 +133,7 @@ typedef struct Module_Renames { } Module_Renames; typedef struct Scheme_Cert { - Scheme_Object so; + Scheme_Inclhash_Object iso; Scheme_Object *mark; Scheme_Object *modidx; Scheme_Object *insp; @@ -151,6 +151,9 @@ typedef struct Scheme_Cert { struct Scheme_Cert *next; } Scheme_Cert; +#define CERT_NO_KEY(c) (MZ_OPT_HASH_KEY(&(c)->iso) & 0x1) +#define CERT_SET_NO_KEY(c) (MZ_OPT_HASH_KEY(&(c)->iso) |= 0x1) + /* Certs encoding: - NULL: no inactive or active certs; maybe inactive certs in nested parts @@ -1803,7 +1806,7 @@ static Scheme_Cert *cons_cert(Scheme_Object *mark, Scheme_Object *modidx, Scheme_Cert *cert; cert = MALLOC_ONE_RT(Scheme_Cert); - cert->so.type = scheme_certifications_type; + cert->iso.so.type = scheme_certifications_type; cert->mark = mark; cert->modidx = modidx; cert->insp = insp; @@ -1811,6 +1814,10 @@ static Scheme_Cert *cons_cert(Scheme_Object *mark, Scheme_Object *modidx, cert->next = next_cert; cert->depth = (next_cert ? next_cert->depth + 1 : 1); + if (!key && (!next_cert || CERT_NO_KEY(next_cert))) { + CERT_SET_NO_KEY(cert); + } + return cert; } @@ -1905,7 +1912,7 @@ static int cert_in_chain(Scheme_Object *mark, Scheme_Object *key, Scheme_Cert *c static Scheme_Object *add_certs(Scheme_Object *o, Scheme_Cert *certs, Scheme_Object *use_key, int active) { - Scheme_Cert *orig_certs, *cl, *now_certs; + Scheme_Cert *orig_certs, *cl, *now_certs, *next_certs; Scheme_Stx *stx = (Scheme_Stx *)o, *res; Scheme_Object *pr; int copy_on_write; @@ -1945,7 +1952,8 @@ static Scheme_Object *add_certs(Scheme_Object *o, Scheme_Cert *certs, Scheme_Obj orig_certs = INACTIVE_CERTS(stx); now_certs = orig_certs; - for (; certs; certs = certs->next) { + for (; certs; certs = next_certs) { + next_certs = certs->next; if (!cert_in_chain(certs->mark, use_key, now_certs)) { if (copy_on_write) { res = (Scheme_Stx *)scheme_make_stx(stx->val, @@ -1964,8 +1972,13 @@ static Scheme_Object *add_certs(Scheme_Object *o, Scheme_Cert *certs, Scheme_Obj stx = res; copy_on_write = 0; } - cl = cons_cert(certs->mark, certs->modidx, certs->insp, use_key, - active ? ACTIVE_CERTS(stx) : INACTIVE_CERTS(stx)); + if (!now_certs && !use_key && CERT_NO_KEY(certs)) { + cl = certs; + next_certs = NULL; + } else { + cl = cons_cert(certs->mark, certs->modidx, certs->insp, use_key, + active ? ACTIVE_CERTS(stx) : INACTIVE_CERTS(stx)); + } now_certs = cl; if (!active) { SCHEME_CDR(stx->certs) = (Scheme_Object *)cl; diff --git a/src/mzscheme/src/vector.c b/src/mzscheme/src/vector.c index acd6c8da45..7fc228e4c5 100644 --- a/src/mzscheme/src/vector.c +++ b/src/mzscheme/src/vector.c @@ -34,6 +34,7 @@ static Scheme_Object *vector_to_list (int argc, Scheme_Object *argv[]); static Scheme_Object *list_to_vector (int argc, Scheme_Object *argv[]); static Scheme_Object *vector_fill (int argc, Scheme_Object *argv[]); static Scheme_Object *vector_to_immutable (int argc, Scheme_Object *argv[]); +static Scheme_Object *vector_to_values (int argc, Scheme_Object *argv[]); static Scheme_Object *zero_length_vector; @@ -105,6 +106,12 @@ scheme_init_vector (Scheme_Env *env) "vector->immutable-vector", 1, 1), env); + scheme_add_global_constant("vector->values", + scheme_make_prim_w_arity2(vector_to_values, + "vector->values", + 1, 3, + 0, -1), + env); } Scheme_Object * @@ -208,7 +215,7 @@ vector_length (int argc, Scheme_Object *argv[]) } static Scheme_Object * -bad_index(char *name, Scheme_Object *i, Scheme_Object *vec) +bad_index(char *name, Scheme_Object *i, Scheme_Object *vec, int bottom) { int n = SCHEME_VEC_SIZE(vec) - 1; @@ -220,7 +227,7 @@ bad_index(char *name, Scheme_Object *i, Scheme_Object *vec) "%s: index %s out of range [%d, %d] for vector: %t", name, scheme_make_provided_string(i, 2, NULL), - 0, n, + bottom, n, vstr, vlen); } else scheme_raise_exn(MZEXN_FAIL_CONTRACT, @@ -244,7 +251,7 @@ scheme_checked_vector_ref (int argc, Scheme_Object *argv[]) i = scheme_extract_index("vector-ref", 1, argc, argv, len, 0); if (i >= len) - return bad_index("vector-ref", argv[1], argv[0]); + return bad_index("vector-ref", argv[1], argv[0], 0); return (SCHEME_VEC_ELS(argv[0]))[i]; } @@ -262,7 +269,7 @@ scheme_checked_vector_set(int argc, Scheme_Object *argv[]) i = scheme_extract_index("vector-set!", 1, argc, argv, len, 0); if (i >= len) - return bad_index("vector-set!", argv[1], argv[0]); + return bad_index("vector-set!", argv[1], argv[0], 0); (SCHEME_VEC_ELS(argv[0]))[i] = argv[2]; @@ -363,3 +370,55 @@ static Scheme_Object *vector_to_immutable (int argc, Scheme_Object *argv[]) return vec; } + +static Scheme_Object *vector_to_values (int argc, Scheme_Object *argv[]) +{ + Scheme_Thread *p; + Scheme_Object *vec, **a; + long len, start, finish, i; + + vec = argv[0]; + + if (!SCHEME_VECTORP(vec)) + scheme_wrong_type("vector->values", "vector", 0, argc, argv); + + len = SCHEME_VEC_SIZE(vec); + + if (argc > 1) + start = scheme_extract_index("vector->values", 1, argc, argv, len + 1, 0); + else + start = 0; + if (argc > 2) + finish = scheme_extract_index("vector->values", 2, argc, argv, len + 1, 0); + else + finish = len; + + if (!(start <= len)) { + bad_index("vector->values", argv[1], vec, 0); + } + if (!(finish >= start && finish <= len)) { + bad_index("vector->values", argv[2], vec, start); + } + + len = finish - start; + if (len == 1) + return SCHEME_VEC_ELS(vec)[start]; + + p = scheme_current_thread; + if (p->values_buffer && (p->values_buffer_size >= len)) + a = p->values_buffer; + else { + a = MALLOC_N(Scheme_Object *, len); + p->values_buffer = a; + p->values_buffer_size = len; + } + + p->ku.multiple.array = a; + p->ku.multiple.count = len; + + for (i = 0; i < len; i++) { + a[i] = SCHEME_VEC_ELS(vec)[start + i]; + } + + return SCHEME_MULTIPLE_VALUES; +}