PageRenderTime 53ms CodeModel.GetById 30ms RepoModel.GetById 0ms app.codeStats 0ms

/collects/unstable/automata/re.rkt

http://github.com/gmarceau/PLT
Racket | 76 lines | 71 code | 5 blank | 0 comment | 1 complexity | 289990b5b2e70ffb167b0f0dddc47800 MD5 | raw file
Possible License(s): BSD-3-Clause, LGPL-2.1 
    

  1. #lang racket/base
    2. 

  2. (require "machine.rkt"
    3. 

  3.          "re-help.rkt"
    4. 

  4.          racket/match
    5. 

  5.          (for-syntax syntax/parse
    6. 

  6.                      racket/syntax
    7. 

  7.                      unstable/syntax
    8. 

  8.                      racket/base
    9. 

  9.                      "re-help.rkt"
    10. 

  10.                      "re-compile.rkt"))
    11. 

  11. 

  12. (define-syntax-rule (define-re-transformer id lam)
    13. 

  13.   (define-syntax id (re-transformer lam)))
    14. 

  14. 

  15. (define-for-syntax (re-expand stx)
    16. 

  16.   (syntax-parse
    17. 

  17.    (syntax-disarm stx (current-code-inspector))
    18. 

  18.    #:literals (complement seq union star epsilon nullset dseq rec unquote)
    19. 

  19.    [((~and op complement) lhs:expr)
    20. 

  20.     (quasisyntax/loc stx
    21. 

  21.       (op #,(re-expand #'lhs)))]
    22. 

  22.    [((~and op rec) v:id lhs:expr)
    23. 

  23.     (quasisyntax/loc stx
    24. 

  24.       (op v #,(re-expand #'lhs)))]
    25. 

  25.    [((~and op unquote) e:expr)
    26. 

  26.     (quasisyntax/loc stx
    27. 

  27.       (op e))]
    28. 

  28.    [((~and op star) lhs:expr)
    29. 

  29.     (quasisyntax/loc stx
    30. 

  30.       (op #,(re-expand #'lhs)))]
    31. 

  31.    [((~and op seq) lhs:expr)
    32. 

  32.     (re-expand #'lhs)]
    33. 

  33.    [((~and op seq) lhs:expr rhs:expr)
    34. 

  34.     (quasisyntax/loc stx
    35. 

  35.       (op #,(re-expand #'lhs) #,(re-expand #'rhs)))]
    36. 

  36.    [((~and op seq) lhs:expr rest:expr ...)
    37. 

  37.     (quasisyntax/loc stx
    38. 

  38.       #,(re-expand #'(op lhs (op rest ...))))]
    39. 

  39.    [((~and op union) lhs:expr)
    40. 

  40.     (re-expand #'lhs)]
    41. 

  41.    [((~and op union) lhs:expr rhs:expr)
    42. 

  42.     (quasisyntax/loc stx
    43. 

  43.       (op #,(re-expand #'lhs) #,(re-expand #'rhs)))]
    44. 

  44.    [((~and op union) lhs:expr rest:expr ...)
    45. 

  45.     (quasisyntax/loc stx
    46. 

  46.       #,(re-expand #'(op lhs (op rest ...))))]
    47. 

  47.    [(~and e (~var transformer (static re-transformer? "re transformer")))
    48. 

  48.     (record-disappeared-uses (list #'transformer))
    49. 

  49.     (quasisyntax/loc stx
    50. 

  50.       #,(re-expand ((re-transformer->re (attribute transformer.value)) #'e)))]
    51. 

  51.    [(~and e ((~var transformer (static re-transformer? "re transformer")) . _))
    52. 

  52.     (record-disappeared-uses (list #'transformer))
    53. 

  53.     (quasisyntax/loc stx
    54. 

  54.       #,(re-expand ((re-transformer->re (attribute transformer.value)) #'e)))]
    55. 

  55.    [((~and op dseq) pat:expr rhs:expr)
    56. 

  56.     (quasisyntax/loc stx
    57. 

  57.       (op pat #,(re-expand #'rhs)))]
    58. 

  58.    [_
    59. 

  59.     stx]))
    60. 

  60. 

  61. (define-for-syntax (re-compile stx)
    62. 

  62.   (syntax-parse
    63. 

  63.    stx
    64. 

  64.    [the-re:sre
    65. 

  65.     (attribute the-re.best)]))
    66. 

  66. 

  67. (define-syntax (re stx)
    68. 

  68.   (with-disappeared-uses
    69. 

  69.       (syntax-case stx ()
    70. 

  70.         [(_ the-re)
    71. 

  71.          (re-compile (re-expand #'the-re))])))
    72. 

    73. 

  73. (provide
    74. 

  74.  complement seq union star epsilon nullset dseq rec unquote
    75. 

  75.  define-re-transformer
    76. 

  76.  re)
    77. 

  77.