more v4-isms
svn: r8523
This commit is contained in:
parent
d113956877
commit
5a08a34f73
|
@ -3,7 +3,7 @@
|
||||||
;;> The `base' module defines some basic low-level syntactic extensions to
|
;;> The `base' module defines some basic low-level syntactic extensions to
|
||||||
;;> MzScheme. It can be used by itself to get these extensions.
|
;;> MzScheme. It can be used by itself to get these extensions.
|
||||||
|
|
||||||
(module base mzscheme
|
#lang mzscheme
|
||||||
|
|
||||||
(provide (all-from-except mzscheme
|
(provide (all-from-except mzscheme
|
||||||
#%module-begin #%top #%app define let let* letrec lambda
|
#%module-begin #%top #%app define let let* letrec lambda
|
||||||
|
@ -19,16 +19,15 @@
|
||||||
(datum->syntax-object
|
(datum->syntax-object
|
||||||
(quote-syntax here)
|
(quote-syntax here)
|
||||||
(list* (quote-syntax #%plain-module-begin)
|
(list* (quote-syntax #%plain-module-begin)
|
||||||
(datum->syntax-object stx
|
(datum->syntax-object
|
||||||
(list (quote-syntax require-for-syntax)
|
stx (list (quote-syntax require-for-syntax) 'swindle/base))
|
||||||
'(lib "base.ss" "swindle")))
|
|
||||||
(cdr e))
|
(cdr e))
|
||||||
stx)
|
stx)
|
||||||
(raise-syntax-error #f "bad syntax" stx)))
|
(raise-syntax-error #f "bad syntax" stx)))
|
||||||
;; This doesn't work anymore (from 203.4)
|
;; This doesn't work anymore (from 203.4)
|
||||||
;; (syntax-rules ()
|
;; (syntax-rules ()
|
||||||
;; [(_ . body) (#%plain-module-begin
|
;; [(_ . body) (#%plain-module-begin
|
||||||
;; (require-for-syntax (lib "base.ss" "swindle")) . body)])
|
;; (require-for-syntax swindle/base) . body)])
|
||||||
)
|
)
|
||||||
|
|
||||||
;;>> (#%top . id)
|
;;>> (#%top . id)
|
||||||
|
@ -593,5 +592,3 @@
|
||||||
[else
|
[else
|
||||||
(loop (cddr as)
|
(loop (cddr as)
|
||||||
(if (memq (car as) outs) r (list* (cadr as) (car as) r)))])))
|
(if (memq (car as) outs) r (list* (cadr as) (car as) r)))])))
|
||||||
|
|
||||||
)
|
|
||||||
|
|
|
@ -3,10 +3,10 @@
|
||||||
;;> This module contains only syntax definitions, which makes Swindle closer
|
;;> This module contains only syntax definitions, which makes Swindle closer
|
||||||
;;> to CLOS -- making the object system much more convenient to use.
|
;;> to CLOS -- making the object system much more convenient to use.
|
||||||
|
|
||||||
(module clos (lib "turbo.ss" "swindle")
|
#lang s-exp swindle/turbo
|
||||||
|
|
||||||
(require (lib "tiny-clos.ss" "swindle"))
|
(require swindle/tiny-clos)
|
||||||
(provide (all-from (lib "tiny-clos.ss" "swindle")))
|
(provide (all-from swindle/tiny-clos))
|
||||||
|
|
||||||
;;; ---------------------------------------------------------------------------
|
;;; ---------------------------------------------------------------------------
|
||||||
;;; General helpers
|
;;; General helpers
|
||||||
|
@ -730,5 +730,3 @@
|
||||||
(provide defgeneric*) (make-provide-syntax defgeneric defgeneric*)
|
(provide defgeneric*) (make-provide-syntax defgeneric defgeneric*)
|
||||||
(provide defclass*) (make-provide-syntax defclass defclass*)
|
(provide defclass*) (make-provide-syntax defclass defclass*)
|
||||||
(provide defentityclass*) (make-provide-syntax defentityclass defentityclass*)
|
(provide defentityclass*) (make-provide-syntax defentityclass defentityclass*)
|
||||||
|
|
||||||
)
|
|
||||||
|
|
|
@ -24,9 +24,10 @@
|
||||||
;;; not things that can be made into a module -- a teachpack is better for
|
;;; not things that can be made into a module -- a teachpack is better for
|
||||||
;;; those.
|
;;; those.
|
||||||
|
|
||||||
(module custom (lib "swindle.ss" "swindle")
|
#lang swindle
|
||||||
|
|
||||||
;; provide all swindle, minus `lambda' which is overriden to `method'
|
;; provide all swindle, minus `lambda' which is overriden to `method'
|
||||||
(provide (all-from-except (lib "swindle.ss" "swindle") lambda))
|
(provide (all-from-except swindle lambda))
|
||||||
(provide (rename lambda~ lambda))
|
(provide (rename lambda~ lambda))
|
||||||
(defsubst lambda~ method)
|
(defsubst lambda~ method)
|
||||||
;; some default customizations
|
;; some default customizations
|
||||||
|
@ -47,9 +48,9 @@
|
||||||
(-defmethod-create-generics- #f)
|
(-defmethod-create-generics- #f)
|
||||||
;; use defgeneric + add-method for accessors (since defmethod now
|
;; use defgeneric + add-method for accessors (since defmethod now
|
||||||
;; wouldn't create the generic)
|
;; wouldn't create the generic)
|
||||||
(-defclass-accessor-mode- :defgeneric))))
|
(-defclass-accessor-mode- :defgeneric)))
|
||||||
|
|
||||||
;;; To make thins even better, it is best to change preferences so Swindle
|
;;; To make things even better, it is best to change preferences so Swindle
|
||||||
;;; syntax get indented correctly. For this, create the default preference
|
;;; syntax get indented correctly. For this, create the default preference
|
||||||
;;; file "plt/collects/defaults/plt-prefs.ss", and in it you can put any
|
;;; file "plt/collects/defaults/plt-prefs.ss", and in it you can put any
|
||||||
;;; specific preferences you want as the defaults for people who run the system
|
;;; specific preferences you want as the defaults for people who run the system
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
(module extra (lib "turbo.ss" "swindle")
|
#lang s-exp swindle/turbo
|
||||||
|
|
||||||
;;> This module defines some additional useful functionality which requires
|
;;> This module defines some additional useful functionality which requires
|
||||||
;;> Swindle.
|
;;> Swindle.
|
||||||
|
|
||||||
(require (lib "clos.ss" "swindle"))
|
(require swindle/clos)
|
||||||
|
|
||||||
;;; ---------------------------------------------------------------------------
|
;;; ---------------------------------------------------------------------------
|
||||||
;;; A convenient `defstruct'
|
;;; A convenient `defstruct'
|
||||||
|
@ -969,5 +969,3 @@
|
||||||
(ui-question str args "Ok/Cancel" 'ok '(ok-cancel) #\o #\c))
|
(ui-question str args "Ok/Cancel" 'ok '(ok-cancel) #\o #\c))
|
||||||
(define* (yes/no? str . args)
|
(define* (yes/no? str . args)
|
||||||
(ui-question str args "Yes/No" 'yes '(yes-no) #\y #\n))
|
(ui-question str args "Yes/No" 'yes '(yes-no) #\y #\n))
|
||||||
|
|
||||||
)
|
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
@ -3,14 +3,10 @@
|
||||||
(module info setup/infotab
|
(module info setup/infotab
|
||||||
;;
|
;;
|
||||||
(define name "Swindle")
|
(define name "Swindle")
|
||||||
(define blurb
|
(define blurb '("Swindle extensions for MzScheme -- CLOS and more."))
|
||||||
'("Swindle extensions for MzScheme -- CLOS and more."))
|
(define help-desk-message "Mz/Mr: (require (lib \"swindle.ss\" \"swindle\"))")
|
||||||
(define help-desk-message
|
|
||||||
"Mz/Mr: (require (lib \"swindle.ss\" \"swindle\"))")
|
|
||||||
(define mzscheme-launcher-names '("swindle"))
|
(define mzscheme-launcher-names '("swindle"))
|
||||||
(define mzscheme-launcher-flags
|
(define mzscheme-launcher-flags '(("-li" "swindle")))
|
||||||
'(("-me"
|
|
||||||
"(namespace-require/copy (quote (lib \"swindle.ss\" \"swindle\")))")))
|
|
||||||
;;
|
;;
|
||||||
;; This simple interface is not enough, use tool.ss instead
|
;; This simple interface is not enough, use tool.ss instead
|
||||||
;; (define drscheme-language-modules
|
;; (define drscheme-language-modules
|
||||||
|
|
2
collects/swindle/lang/reader.ss
Normal file
2
collects/swindle/lang/reader.ss
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
#lang s-exp syntax/module-reader
|
||||||
|
swindle
|
17
collects/swindle/main.ss
Normal file
17
collects/swindle/main.ss
Normal file
|
@ -0,0 +1,17 @@
|
||||||
|
;;; Written by Eli Barzilay: Maze is Life! (eli@barzilay.org)
|
||||||
|
|
||||||
|
;;> This module combines all modules to form the Swindle language module.
|
||||||
|
;;>
|
||||||
|
;;> Note that it does not re-define `#%module-begin', so the language used
|
||||||
|
;;> for transformers is still the one defined by `turbo'.
|
||||||
|
|
||||||
|
#lang s-exp swindle/turbo
|
||||||
|
|
||||||
|
(require swindle/clos swindle/extra)
|
||||||
|
(provide (all-from swindle/turbo)
|
||||||
|
(all-from swindle/clos)
|
||||||
|
(all-from swindle/extra))
|
||||||
|
(current-prompt-read
|
||||||
|
(let ([old-prompt-read (current-prompt-read)])
|
||||||
|
(lambda () (display "=") (flush-output) (old-prompt-read))))
|
||||||
|
(install-swindle-printer)
|
|
@ -3,14 +3,11 @@
|
||||||
;;> A lot of miscellaneous functionality that is needed for Swindle, or
|
;;> A lot of miscellaneous functionality that is needed for Swindle, or
|
||||||
;;> useful by itself.
|
;;> useful by itself.
|
||||||
|
|
||||||
(module misc (lib "base.ss" "swindle")
|
#lang s-exp swindle/base
|
||||||
|
|
||||||
(require (lib "list.ss"))
|
(require mzlib/list) (provide (all-from mzlib/list))
|
||||||
(provide (all-from (lib "list.ss")))
|
(require mzlib/etc) (provide (all-from mzlib/etc))
|
||||||
(require (lib "etc.ss"))
|
(require mzlib/string) (provide (all-from mzlib/string))
|
||||||
(provide (all-from (lib "etc.ss")))
|
|
||||||
(require (all-except (lib "string.ss")))
|
|
||||||
(provide (all-from (lib "string.ss")))
|
|
||||||
|
|
||||||
;; ----------------------------------------------------------------------------
|
;; ----------------------------------------------------------------------------
|
||||||
;;>>... Convenient syntax definitions
|
;;>>... Convenient syntax definitions
|
||||||
|
@ -157,7 +154,7 @@
|
||||||
;;> with `defsubst' above).
|
;;> with `defsubst' above).
|
||||||
;;> * A `letmacro' form for local macros is provided.
|
;;> * A `letmacro' form for local macros is provided.
|
||||||
|
|
||||||
(require-for-syntax (lib "dmhelp.ss" "mzlib" "private"))
|
(require-for-syntax mzlib/private/dmhelp)
|
||||||
(provide defmacro letmacro)
|
(provide defmacro letmacro)
|
||||||
(define-syntaxes (defmacro letmacro)
|
(define-syntaxes (defmacro letmacro)
|
||||||
(let ()
|
(let ()
|
||||||
|
@ -1900,5 +1897,3 @@
|
||||||
[(_ str clause ...)
|
[(_ str clause ...)
|
||||||
#`(let ([s str])
|
#`(let ([s str])
|
||||||
(cond #,@(map do-clause (syntax->list #'(clause ...)))))]))
|
(cond #,@(map do-clause (syntax->list #'(clause ...)))))]))
|
||||||
|
|
||||||
)
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
(module patterns mzscheme
|
#lang mzscheme
|
||||||
|
|
||||||
(provide (all-from-except mzscheme
|
(provide (all-from-except mzscheme
|
||||||
define-values
|
define-values
|
||||||
|
@ -263,5 +263,3 @@
|
||||||
;; (require foo)
|
;; (require foo)
|
||||||
;; (define a (make-point 1 2))
|
;; (define a (make-point 1 2))
|
||||||
;; (let ([(make-point x y) a]) (+ x y))
|
;; (let ([(make-point x y) a]) (+ x y))
|
||||||
|
|
||||||
)
|
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
;;> this just defines the basic functionality, the `misc' module defines
|
;;> this just defines the basic functionality, the `misc' module defines
|
||||||
;;> many common setters.
|
;;> many common setters.
|
||||||
|
|
||||||
(module setf mzscheme
|
#lang mzscheme
|
||||||
|
|
||||||
;;>> (setf! place value ...)
|
;;>> (setf! place value ...)
|
||||||
;;> Expand `(setf! (foo ...) v)' to `(set-foo! ... v)'. The generated
|
;;> Expand `(setf! (foo ...) v)' to `(set-foo! ... v)'. The generated
|
||||||
|
@ -274,5 +274,3 @@
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
#`(let ([p1 #,p])
|
#`(let ([p1 #,p])
|
||||||
(begin0 (car p1) (setf! #,p (cdr p1))))))])))))
|
(begin0 (car p1) (setf! #,p (cdr p1))))))])))))
|
||||||
|
|
||||||
)
|
|
||||||
|
|
|
@ -1,21 +0,0 @@
|
||||||
;;; Written by Eli Barzilay: Maze is Life! (eli@barzilay.org)
|
|
||||||
|
|
||||||
;;> This module combines all modules to form the Swindle language module.
|
|
||||||
;;>
|
|
||||||
;;> Note that it does not re-define `#%module-begin', so the language used
|
|
||||||
;;> for transformers is still the one defined by `turbo'.
|
|
||||||
|
|
||||||
(module swindle (lib "turbo.ss" "swindle")
|
|
||||||
(require (lib "clos.ss" "swindle")
|
|
||||||
(lib "extra.ss" "swindle"))
|
|
||||||
(provide (all-from (lib "turbo.ss" "swindle"))
|
|
||||||
(all-from (lib "clos.ss" "swindle"))
|
|
||||||
(all-from (lib "extra.ss" "swindle")))
|
|
||||||
(current-prompt-read
|
|
||||||
(let ([old-prompt-read (current-prompt-read)])
|
|
||||||
(lambda () (display "=") (flush-output) (old-prompt-read))))
|
|
||||||
(install-swindle-printer)
|
|
||||||
;; This comes out ugly in DrScheme.
|
|
||||||
;; (printf
|
|
||||||
;; "Welcome to Swindle -- Eli Barzilay: Maze is Life! (eli@barzilay.org)\n")
|
|
||||||
)
|
|
|
@ -30,7 +30,7 @@
|
||||||
;;; DAMAGES.
|
;;; DAMAGES.
|
||||||
;;; ***************************************************************************
|
;;; ***************************************************************************
|
||||||
|
|
||||||
(module tiny-clos (lib "base.ss" "swindle")
|
#lang s-exp swindle/base
|
||||||
|
|
||||||
;;; A very simple CLOS-like language, embedded in Scheme, with a simple MOP.
|
;;; A very simple CLOS-like language, embedded in Scheme, with a simple MOP.
|
||||||
;;; The features of the default base language are:
|
;;; The features of the default base language are:
|
||||||
|
@ -116,7 +116,7 @@
|
||||||
;;; OK, now let's get going. But, as usual, before we can do anything
|
;;; OK, now let's get going. But, as usual, before we can do anything
|
||||||
;;; interesting, we have to muck around for a bit first. First, we need to
|
;;; interesting, we have to muck around for a bit first. First, we need to
|
||||||
;;; load the support library. [-- replaced with a module.]
|
;;; load the support library. [-- replaced with a module.]
|
||||||
(require (lib "misc.ss" "swindle"))
|
(require swindle/misc)
|
||||||
|
|
||||||
;; This is a convenient function for raising exceptions
|
;; This is a convenient function for raising exceptions
|
||||||
(define (raise* exn-maker fmt . args)
|
(define (raise* exn-maker fmt . args)
|
||||||
|
@ -2336,5 +2336,3 @@
|
||||||
;;> compute-methods
|
;;> compute-methods
|
||||||
;;> compute-method-more-specific?
|
;;> compute-method-more-specific?
|
||||||
;;> compute-apply-methods
|
;;> compute-apply-methods
|
||||||
|
|
||||||
)
|
|
||||||
|
|
|
@ -1,15 +1,17 @@
|
||||||
;;; Written by Eli Barzilay: Maze is Life! (eli@barzilay.org)
|
;;; Written by Eli Barzilay: Maze is Life! (eli@barzilay.org)
|
||||||
|
|
||||||
;; This allows adding a Swindle icon on startup.
|
;; Add the Swindle languages to DrScheme
|
||||||
(module tool mzscheme
|
#lang mzscheme
|
||||||
(require (lib "unit.ss")
|
|
||||||
(lib "tool.ss" "drscheme")
|
(require mzlib/unit
|
||||||
(lib "class.ss")
|
drscheme/tool
|
||||||
(lib "list.ss")
|
mzlib/class
|
||||||
(lib "mred.ss" "mred")
|
mzlib/list
|
||||||
(lib "sendurl.ss" "net")
|
mred/mred
|
||||||
(lib "string-constant.ss" "string-constants"))
|
net/sendurl
|
||||||
|
string-constants/string-constant)
|
||||||
(provide tool@)
|
(provide tool@)
|
||||||
|
|
||||||
(define tool@
|
(define tool@
|
||||||
(unit (import drscheme:tool^) (export drscheme:tool-exports^)
|
(unit (import drscheme:tool^) (export drscheme:tool-exports^)
|
||||||
;; Swindle languages
|
;; Swindle languages
|
||||||
|
@ -117,8 +119,7 @@
|
||||||
name entry-name num one-line url)))))
|
name entry-name num one-line url)))))
|
||||||
(define phase1 void)
|
(define phase1 void)
|
||||||
(define (phase2)
|
(define (phase2)
|
||||||
(for-each (lambda (args)
|
(for-each (lambda (args) (apply add-swindle-language `(,@args #f)))
|
||||||
(apply add-swindle-language `(,@args #f)))
|
|
||||||
'(("Swindle" "swindle" "Full Swindle" 0
|
'(("Swindle" "swindle" "Full Swindle" 0
|
||||||
"Full Swindle extensions")
|
"Full Swindle extensions")
|
||||||
("Swindle w/o CLOS" "turbo" "Swindle without CLOS" 1
|
("Swindle w/o CLOS" "turbo" "Swindle without CLOS" 1
|
||||||
|
@ -159,4 +160,4 @@
|
||||||
name file dname counter one-line url))))))))
|
name file dname counter one-line url))))))))
|
||||||
(for-each do-customize
|
(for-each do-customize
|
||||||
(sort (map path->string (directory-list)) string<?))))
|
(sort (map path->string (directory-list)) string<?))))
|
||||||
)))
|
))
|
||||||
|
|
|
@ -4,13 +4,12 @@
|
||||||
;;> new language module. Use this module to get most of Swindle's
|
;;> new language module. Use this module to get most of Swindle's
|
||||||
;;> functionality which is unrelated to the object system.
|
;;> functionality which is unrelated to the object system.
|
||||||
|
|
||||||
(module turbo (lib "base.ss" "swindle")
|
#lang s-exp swindle/base
|
||||||
(require (lib "setf.ss" "swindle")
|
|
||||||
(lib "misc.ss" "swindle"))
|
(require swindle/setf swindle/misc)
|
||||||
(provide (all-from-except (lib "base.ss" "swindle")
|
(provide (all-from-except swindle/base set! set!-values #%module-begin)
|
||||||
set! set!-values #%module-begin)
|
|
||||||
(rename module-begin~ #%module-begin)
|
(rename module-begin~ #%module-begin)
|
||||||
(all-from-except (lib "setf.ss" "swindle") setf! psetf!)
|
(all-from-except swindle/setf setf! psetf!)
|
||||||
;;>> (set! place value ...) [*syntax*]
|
;;>> (set! place value ...) [*syntax*]
|
||||||
;;>> (pset! place value ...) [*syntax*]
|
;;>> (pset! place value ...) [*syntax*]
|
||||||
;;>> (set!-values (place ...) expr) [*syntax*]
|
;;>> (set!-values (place ...) expr) [*syntax*]
|
||||||
|
@ -19,7 +18,7 @@
|
||||||
;;> `set!' and `set!-values' syntaxes are overridden.
|
;;> `set!' and `set!-values' syntaxes are overridden.
|
||||||
(rename setf! set!) (rename psetf! pset!)
|
(rename setf! set!) (rename psetf! pset!)
|
||||||
(rename setf!-values set!-values)
|
(rename setf!-values set!-values)
|
||||||
(all-from (lib "misc.ss" "swindle")))
|
(all-from swindle/misc))
|
||||||
;;>> #%module-begin
|
;;>> #%module-begin
|
||||||
;;> `turbo' is a language module -- it redefines `#%module-begin' to load
|
;;> `turbo' is a language module -- it redefines `#%module-begin' to load
|
||||||
;;> itself for syntax definitions.
|
;;> itself for syntax definitions.
|
||||||
|
@ -41,4 +40,3 @@
|
||||||
;; (#%plain-module-begin
|
;; (#%plain-module-begin
|
||||||
;; (require-for-syntax (lib "turbo.ss" "swindle")) . body)])
|
;; (require-for-syntax (lib "turbo.ss" "swindle")) . body)])
|
||||||
)
|
)
|
||||||
)
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user