From b2611aee1ba0ace9ebcc6ed11d262e1703fa7dcd Mon Sep 17 00:00:00 2001
From: Jack Firth <jackhfirth@gmail.com>
Date: Wed, 13 Apr 2022 17:37:45 -0700
Subject: [PATCH] Move semantic actions into their own module

---
 base/derivation.rkt      | 42 ++---------------------------
 base/grammar.rkt         |  3 ++-
 base/semantic-action.rkt | 58 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 62 insertions(+), 41 deletions(-)
 create mode 100644 base/semantic-action.rkt

diff --git a/base/derivation.rkt b/base/derivation.rkt
index de8b141..eed4517 100644
--- a/base/derivation.rkt
+++ b/base/derivation.rkt
@@ -17,17 +17,7 @@
     (-> semantic-action? parser-derivation? #:rest (listof parser-derivation?)
         nonterminal-derivation?))]
   [parser-derivation->syntax (-> parser-derivation? syntax?)]
-  [parser-derivation->datum (-> parser-derivation? any/c)]
-  [semantic-action? predicate/c]
-  [cut-action cut-action?]
-  [cut-action? predicate/c]
-  [splice-action splice-action?]
-  [splice-action? predicate/c]
-  [label-action? predicate/c]
-  [label-action (->* (any/c) (#:properties hash? #:expression-properties hash?) label-action?)]
-  [label-action-value (-> label-action? any/c)]
-  [label-action-properties (-> label-action? hash?)]
-  [label-action-expression-properties (-> label-action? hash?)]))
+  [parser-derivation->datum (-> parser-derivation? any/c)]))
 
 
 (require racket/match
@@ -35,6 +25,7 @@
          racket/struct
          rebellion/collection/vector
          rebellion/private/static-name
+         yaragg/base/semantic-action
          yaragg/base/token)
 
 
@@ -47,35 +38,6 @@
 ;@----------------------------------------------------------------------------------------------------
 
 
-(define (semantic-action? v)
-  (or (cut-action? v) (splice-action? v) (label-action? v)))
-
-
-(struct cut-action () #:transparent #:constructor-name constructor:cut-action #:omit-define-syntaxes)
-(define cut-action (constructor:cut-action))
-
-
-(struct splice-action ()
-  #:transparent #:constructor-name constructor:splice-action #:omit-define-syntaxes)
-(define splice-action (constructor:splice-action))
-
-
-(struct label-action (value expression-properties properties)
-  #:transparent
-  #:constructor-name constructor:label-action
-  #:omit-define-syntaxes
-  #:guard
-  (struct-guard/c any/c
-                  (hash/c any/c any/c #:immutable #true #:flat? #true)
-                  (hash/c any/c any/c #:immutable #true #:flat? #true)))
-
-
-(define (label-action value
-                      #:properties [properties (hash)]
-                      #:expression-properties [expression-properties (hash)])
-  (constructor:label-action value properties expression-properties))
-
-
 (define (parser-derivation? v)
   (or (terminal-derivation? v) (nonterminal-derivation? v)))
 
diff --git a/base/grammar.rkt b/base/grammar.rkt
index 1f29a2e..8538b5b 100644
--- a/base/grammar.rkt
+++ b/base/grammar.rkt
@@ -21,7 +21,8 @@
 (require racket/sequence
          racket/set
          rebellion/collection/vector
-         yaragg/base/derivation)
+         yaragg/base/derivation
+         yaragg/base/semantic-action)
 
 
 ;@----------------------------------------------------------------------------------------------------
diff --git a/base/semantic-action.rkt b/base/semantic-action.rkt
new file mode 100644
index 0000000..41f82c1
--- /dev/null
+++ b/base/semantic-action.rkt
@@ -0,0 +1,58 @@
+#lang racket/base
+
+
+(require racket/contract/base)
+
+
+(provide
+ (contract-out
+  [semantic-action? predicate/c]
+  [cut-action cut-action?]
+  [cut-action? predicate/c]
+  [splice-action splice-action?]
+  [splice-action? predicate/c]
+  [label-action? predicate/c]
+  [label-action (->* (any/c) (#:properties hash? #:expression-properties hash?) label-action?)]
+  [label-action-value (-> label-action? any/c)]
+  [label-action-properties (-> label-action? hash?)]
+  [label-action-expression-properties (-> label-action? hash?)]))
+
+
+(require racket/match
+         racket/sequence
+         racket/struct
+         rebellion/collection/vector
+         rebellion/private/static-name
+         yaragg/base/token)
+
+
+;@----------------------------------------------------------------------------------------------------
+
+
+(define (semantic-action? v)
+  (or (cut-action? v) (splice-action? v) (label-action? v)))
+
+
+(struct cut-action () #:transparent #:constructor-name constructor:cut-action #:omit-define-syntaxes)
+(define cut-action (constructor:cut-action))
+
+
+(struct splice-action ()
+  #:transparent #:constructor-name constructor:splice-action #:omit-define-syntaxes)
+(define splice-action (constructor:splice-action))
+
+
+(struct label-action (value expression-properties properties)
+  #:transparent
+  #:constructor-name constructor:label-action
+  #:omit-define-syntaxes
+  #:guard
+  (struct-guard/c any/c
+                  (hash/c any/c any/c #:immutable #true #:flat? #true)
+                  (hash/c any/c any/c #:immutable #true #:flat? #true)))
+
+
+(define (label-action value
+                      #:properties [properties (hash)]
+                      #:expression-properties [expression-properties (hash)])
+  (constructor:label-action value properties expression-properties))