[private] disallow set-bang in modules using trivial

define.rkt

@@ -2,9 +2,11 @@
 
 (provide
   define: let:
+  (all-from-out trivial/private/set-bang)
 )
 
 (require
+  trivial/private/set-bang
   (for-syntax
     trivial/private/common
     racket/base)

math.rkt

@@ -11,8 +11,11 @@
   expt:
 
   define-num: let-num:
+
+  set!
 )
 
 (require
+  trivial/private/set-bang
   (only-in trivial/private/math
     +: -: *: /: expt: let-num: define-num:))

no-colon.rkt

@@ -4,6 +4,7 @@
 ;;  but without the trailing colon.
 
 (provide
+  set!
   (all-from-out trivial/define/no-colon)
   (all-from-out trivial/format/no-colon)
   (all-from-out trivial/function/no-colon)
@@ -12,6 +13,7 @@
   (all-from-out trivial/vector/no-colon))
 
 (require
+  trivial/private/set-bang
   trivial/define/no-colon
   trivial/format/no-colon
   trivial/function/no-colon

private/db.rkt

@@ -24,6 +24,10 @@
   ;; define schema
   ;; start connection
   ;; query-exec
+
+  ;; --
+  (for-syntax
+    connection-key)
 )
 
 ;; -----------------------------------------------------------------------------

private/math.rkt

@@ -18,6 +18,7 @@
     nat/expand
     int/expand
     num/expand
+    num-key
     num-define
     num-let)
 )
@@ -91,8 +92,8 @@
 
 ;; -----------------------------------------------------------------------------
 
-(define-syntax define-num: (make-keyword-alias 'define num-define))
-(define-syntax let-num: (make-keyword-alias 'let num-let))
+(define-syntax define-num: (make-keyword-alias #'define num-define))
+(define-syntax let-num: (make-keyword-alias #'let num-let))
 
 (define-syntax make-numeric-operator
   (syntax-parser

private/regexp.rkt

@@ -13,6 +13,7 @@
   regexp-match:
 
   (for-syntax
+    rx-key
     rx-define
     rx-let)
 )
@@ -108,7 +109,7 @@
   (define parse-groups/byte-pregexp
     parse-groups/byte-regexp)
 
-  (define-values (num-groups-key rx? rx-define rx-let)
+  (define-values (rx-key rx? rx-define rx-let)
     (make-value-property 'rx:groups parse-groups))
   (define-syntax-class/predicate pattern/groups rx?)
 )
@@ -126,7 +127,7 @@
            [(_ pat:pattern/groups)
             (syntax-property
               (syntax/loc stx (f* pat.expanded))
-              num-groups-key
+              rx-key
               #'pat.evidence)]
            [_ #f])))) ...)]))
 

private/set-bang.rkt

@@ -0,0 +1,33 @@
+#lang typed/racket/base
+
+(provide
+  (rename-out [set!: set!])
+)
+
+(require
+  (for-syntax
+    racket/base
+    syntax/parse
+    trivial/private/common)
+  (only-in trivial/private/db connection-key)
+  (only-in trivial/private/math num-key)
+  (only-in trivial/private/regexp rx-key)
+  (only-in trivial/private/vector vector-length-key)
+)
+
+;; =============================================================================
+
+(define-for-syntax (has-important-syntax-property? stx)
+  (or #t)) ;; Safe over-approximation
+;   (syntax-property stx connection-key)
+;   (syntax-property stx num-key)
+;   (syntax-property stx rx-key)
+;   (syntax-property stx vector-length-key)))
+
+(define-syntax set!: (make-keyword-alias #'set!
+  (lambda (stx) (syntax-parse stx
+   [(_ name val)
+    #:when (has-important-syntax-property? #'name)
+    (raise-syntax-error 'trivial "mutation not allowed"); stx); #'name)
+    #'(void)]
+   [_ #f]))))

regexp.rkt

@@ -3,6 +3,7 @@
 ;; Stronger types for regular expression matching.
 
 (provide
+  set!
   regexp:       define-regexp:       let-regexp:
   pregexp:
   byte-regexp:
@@ -20,4 +21,7 @@
   ;; Will raise a compile-time exception if the pattern contains unmatched groups.
 )
 
-(require trivial/private/regexp)
+(require
+  trivial/private/regexp
+  trivial/private/set-bang
+)

test/define-fail.rkt

@@ -0,0 +1,13 @@
+#lang racket/base
+(require trivial/private/test-common
+  (only-in typed/racket/base
+    ann Zero))
+
+(module+ test (test-compile-error
+  #:require trivial/math
+  #:exn #rx"mutation not allowed"
+
+  (let-num: ([n 5])
+    (set! n 6)
+    (ann (-: n 5) Zero))
+))

vector.rkt

@@ -1,6 +1,7 @@
 #lang typed/racket/base
 
 (provide
+  set!
   (all-from-out racket/vector)
 
   define-vector:
@@ -26,6 +27,7 @@
 
 (require
   racket/vector
+  trivial/private/set-bang
   (only-in trivial/private/vector
     define-vector:
     let-vector: