commit 9e5c02522ffc9f134dfe82dcde8d7370a52c01fd
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Wed, 14 Dec 2016 21:28:22 +0100
Initial commit
Diffstat:
8 files changed, 309 insertions(+), 0 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1,6 @@
+*~
+\#*
+.\#*
+.DS_Store
+compiled/
+/doc/
diff --git a/.travis.yml b/.travis.yml
@@ -0,0 +1,58 @@
+language: c
+
+# Based from: https://github.com/greghendershott/travis-racket
+
+# Optional: Remove to use Travis CI's older infrastructure.
+sudo: false
+
+env:
+ global:
+ # Supply a global RACKET_DIR environment variable. This is where
+ # Racket will be installed. A good idea is to use ~/racket because
+ # that doesn't require sudo to install and is therefore compatible
+ # with Travis CI's newer container infrastructure.
+ - RACKET_DIR=~/racket
+ matrix:
+ # Supply at least one RACKET_VERSION environment variable. This is
+ # used by the install-racket.sh script (run at before_install,
+ # below) to select the version of Racket to download and install.
+ #
+ # Supply more than one RACKET_VERSION (as in the example below) to
+ # create a Travis-CI build matrix to test against multiple Racket
+ # versions.
+ - RACKET_VERSION=6.0
+ - RACKET_VERSION=6.1
+ - RACKET_VERSION=6.1.1
+ - RACKET_VERSION=6.2
+ - RACKET_VERSION=6.3
+ - RACKET_VERSION=6.4
+ - RACKET_VERSION=6.5
+ - RACKET_VERSION=6.6
+ - RACKET_VERSION=6.7
+ - RACKET_VERSION=HEAD
+
+matrix:
+ allow_failures:
+# - env: RACKET_VERSION=HEAD
+ fast_finish: true
+
+before_install:
+- git clone https://github.com/greghendershott/travis-racket.git ~/travis-racket
+- cat ~/travis-racket/install-racket.sh | bash # pipe to bash not sh!
+- export PATH="${RACKET_DIR}/bin:${PATH}" #install-racket.sh can't set for us
+
+install:
+ - raco pkg install --deps search-auto
+
+before_script:
+
+# Here supply steps such as raco make, raco test, etc. You can run
+# `raco pkg install --deps search-auto` to install any required
+# packages without it getting stuck on a confirmation prompt.
+script:
+ - raco test -x -p scope-operations
+
+after_success:
+ - raco setup --check-pkg-deps --pkgs scope-operations
+ - raco pkg install --deps search-auto cover cover-coveralls
+ - raco cover -b -f coveralls -d $TRAVIS_BUILD_DIR/coverage .
diff --git a/LICENSE.txt b/LICENSE.txt
@@ -0,0 +1,11 @@
+scope-operations
+Copyright (c) 2016 georges
+
+This package is distributed under the GNU Lesser General Public
+License (LGPL). This means that you can link scope-operations into proprietary
+applications, provided you follow the rules stated in the LGPL. You
+can also modify this package; if you distribute a modified version,
+you must distribute it under the terms of the LGPL, which in
+particular means that you must release the source code for the
+modified software. See http://www.gnu.org/copyleft/lesser.html
+for more information.
diff --git a/README.md b/README.md
@@ -0,0 +1,3 @@
+scope-operations
+================
+README text here.
diff --git a/info.rkt b/info.rkt
@@ -0,0 +1,9 @@
+#lang info
+(define collection "scope-operations")
+(define deps '("base"
+ "rackunit-lib"))
+(define build-deps '("scribble-lib" "racket-doc"))
+(define scribblings '(("scribblings/scope-operations.scrbl" ())))
+(define pkg-desc "Description Here")
+(define version "0.0")
+(define pkg-authors '(georges))
diff --git a/main.rkt b/main.rkt
@@ -0,0 +1,100 @@
+#lang racket
+
+(provide scopes/c
+ →scopes
+ →scopes*
+ (rename-out [→scopes ->scopes]
+ [→scopes* ->scopes*])
+ empty-scopes
+ scopes-add
+ scopes-remove
+ scopes-flip
+ scopes-intersect
+ (rename-out [scopes-flip scopes-symmetric-difference])
+ single-scope?
+ scope-kind
+ use-site-scope?
+ macro-scope?
+ module-scope?
+ intdef-scope?
+ local-scope?
+ top-scope?)
+
+(define scopes/c
+ (->* (syntax?) ([or/c 'add 'remove 'flip]) syntax?))
+
+(define/contract (→scopes stx)
+ (-> syntax? scopes/c)
+ (make-syntax-delta-introducer (datum->syntax stx 'stx)
+ (datum->syntax #f 'zero)))
+
+(define/contract empty-scopes
+ scopes/c
+ (→scopes (datum->syntax #f 'zero)))
+
+(define/contract (→scopes* stx)
+ (-> (or/c syntax? scopes/c) scopes/c)
+ (if (syntax? stx)
+ (→scopes stx)
+ stx))
+
+(define/contract (scopes-add sc1 sc2)
+ (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
+ (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes)
+ 'add)))
+
+(define/contract (scopes-remove sc1 sc2)
+ (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
+ (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes)
+ 'remove)))
+
+(define/contract (scopes-flip sc1 sc2)
+ (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
+ (→scopes ((→scopes* sc1) ((→scopes* sc2) empty-scopes)
+ 'flip)))
+
+(define/contract (scopes-intersect sc1 sc2)
+ (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
+ (scopes-remove sc1 (scopes-remove sc1 sc2)))
+
+#;(define/contract (scopes-symmetric-difference sc1 sc2)
+ (-> (or/c syntax? scopes/c) (or/c syntax? scopes/c) scopes/c)
+ (scopes-add (scopes-remove sc1 sc2)
+ (scopes-remove sc2 sc1)))
+
+(define/contract (single-scope? sc)
+ (-> (or/c syntax? scopes/c) boolean?)
+ (= (length (hash-ref (syntax-debug-info ((→scopes* sc) empty-scopes))
+ 'context))))
+
+(define/contract (scope-kind sc)
+ (-> (and/c (or/c syntax? scopes/c) single-scope?) symbol?)
+ (define stx ((→scopes* sc) empty-scopes))
+ (vector-ref (list-ref (hash-ref (syntax-debug-info stx) 'context) 0) 1))
+
+(define/contract (use-site-scope? sc)
+ (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
+ (eq? (scope-kind sc) 'use-site))
+
+(define/contract (macro-scope? sc)
+ (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
+ (eq? (scope-kind sc) 'macro))
+
+(define/contract (module-scope? sc)
+ (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
+ (eq? (scope-kind sc) 'module))
+
+(define/contract (intdef-scope? sc)
+ (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
+ (eq? (scope-kind sc) 'intdef))
+
+(define/contract (local-scope? sc)
+ (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
+ (eq? (scope-kind sc) 'local))
+
+;; Untested, I've seen this once, but can't remember where exactly. I think it
+;; occured while expanding a module with local-expand, and injecting the
+;; expanded body somewhere else.
+(define/contract (top-scope? sc)
+ (-> (and/c (or/c syntax? scopes/c) single-scope?) boolean?)
+ (eq? (scope-kind sc) 'top))
+\ No newline at end of file
diff --git a/scribblings/scope-operations.scrbl b/scribblings/scope-operations.scrbl
@@ -0,0 +1,95 @@
+#lang scribble/manual
+@require[@for-label[scope-operations
+ racket/base]]
+
+@title{scope-operations}
+@author{georges}
+
+@defmodule[scope-operations]
+
+@defproc[(scopes/c [v any/c]) boolean?]{
+ Contract which recognizes a set of scopes, represented as an introducer
+ function. Equivalent to:
+ @racketblock[(->* (syntax?)
+ ([or/c 'add 'remove 'flip])
+ syntax?)]
+}
+
+@defproc*[(((→scopes [stx syntax?]) scopes/c)
+ ((->scopes [stx syntax?]) scopes/c))]{
+ Extracts the scopes present on the topmost syntax object of @racket[stx].
+ This is equivalent to:
+
+ @racket[
+ (make-syntax-delta-introducer (datum->syntax stx 'stx)
+ (datum->syntax #f 'zero))]
+
+ Unlike a @racket[make-syntax-delta-introducer], this procedure does not
+ expect a second argument (always creating an introducer for all the scopes
+ present on @racket[stx]), and works on syntax objects which are not
+ identifiers.}
+
+@defproc*[(((→scopes* [stx (or/c syntax? scopes/c)]) scopes/c)
+ ((->scopes* [stx (or/c syntax? scopes/c)]) scopes/c))]{
+ Lenient version of @racket[→scopes], which acts as a no-op when passed a set
+ of scopes, instead of raising an error.}
+
+@defthing[empty-scopes]{
+ The empty set of scopes, as produced by:
+ @racketblock[(→scopes (datum->syntax #f 'zero))]
+}
+
+@defproc[(scopes-add [sc1 (or/c syntax? scopes/c)]
+ [sc2 (or/c syntax? scopes/c)])
+ scopes/c]{Set union of the given sets of scopes.}
+
+@defproc[(scopes-remove [sc1 (or/c syntax? scopes/c)]
+ [sc2 (or/c syntax? scopes/c)])
+ scopes/c]{Set difference of the given sets of scopes.
+
+ The resulting set of scopes contains all the scopes present in @racket[sc1]
+ which are not present in @racket[sc2].}
+
+@defproc*[(((scopes-flip [sc1 (or/c syntax? scopes/c)]
+ [sc2 (or/c syntax? scopes/c)])
+ scopes/c)
+ ((scopes-symmetric-difference [sc1 (or/c syntax? scopes/c)]
+ [sc2 (or/c syntax? scopes/c)])
+ scopes/c))]{
+
+ Flips the scopes in @racket[sc2] on the @racket[sc1] set of scopes.
+
+ The resulting set of scopes contains all the scopes present in @racket[sc1]
+ which are not present in @racket[sc2], as well as the scopes present in
+ @racket[sc2] which were not present in @racket[sc1].
+
+ Flipping the @racket[sc2] scopes on @racket[sc1] has the same effect as
+ computing the symmetric difference of the two sets of scopes.}
+
+@defproc[(scopes-intersect [sc1 (or/c syntax? scopes/c)]
+ [sc2 (or/c syntax? scopes/c)])
+ scopes/c]{Set intersection of the given sets of scopes.}
+
+
+@defproc[(single-scope? [sc (or/c syntax? scopes/c)]) boolean?]{
+ Predicate which returns @racket[#true] iff the given set of scopes contains
+ only a single scope.}
+
+@defproc[(scope-kind [sc (and/c (or/c syntax? scopes/c) single-scope?)])
+ symbol?]{
+ Returns the kind of the single scope in @racket[sc]. To my knowledge, this
+ will be one of @racket[use-site], @racket[macro], @racket[module],
+ @racket[intdef], @racket[local] or @racket[top].}
+
+@defproc[(use-site-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
+ boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'use-site)]}
+@defproc[(macro-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
+ boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'macro)]}
+@defproc[(module-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
+ boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'module)]}
+@defproc[(intdef-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
+ boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'intdef)]}
+@defproc[(local-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
+ boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'local)]}
+@defproc[(top-scope? [sc (and/c (or/c syntax? scopes/c) single-scope?)])
+ boolean?]{A shorthand for @racket[(eq? (scope-kind sc) 'top)]}
diff --git a/short.rkt b/short.rkt
@@ -0,0 +1,25 @@
+#lang racket
+
+(require scope-operations)
+(provide scopes/c
+ →scopes
+ →scopes*
+ ->scopes
+ ->scopes*
+ (rename-out [empty-scopes scopes0]
+ [scopes-add scopes+]
+ [scopes-add scopes∪]
+ [scopes-remove scopes-]
+ [scopes-flip scopes~]
+ [scopes-intersect scopes∩]
+ [scopes-symmetric-difference scopesΔ]
+ [scopes-symmetric-difference scopes⊖]
+ [scopes-symmetric-difference scopes⊕])
+ single-scope?
+ scope-kind
+ use-site-scope?
+ macro-scope?
+ module-scope?
+ intdef-scope?
+ local-scope?
+ top-scope?)
+\ No newline at end of file
