PageRenderTime 50ms CodeModel.GetById 27ms RepoModel.GetById 0ms app.codeStats 0ms

/collects/unstable/automata/re.rkt

http://github.com/dyoo/racket
Racket | 79 lines | 73 code | 6 blank | 0 comment | 1 complexity | f72179cdc2b0de4223d985ffacf7c858 MD5 | raw file
Possible License(s): BSD-3-Clause 
    

  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 code-insp (variable-reference->module-declaration-inspector
    16. 

  16.                               (#%variable-reference)))
    17. 

  17. 

  18. (define-for-syntax (re-expand stx)
    19. 

  19.   (syntax-parse
    20. 

  20.    (syntax-disarm stx code-insp)
    21. 

  21.    #:literals (complement seq union star epsilon nullset dseq rec unquote)
    22. 

  22.    [((~and op complement) lhs:expr)
    23. 

  23.     (quasisyntax/loc stx
    24. 

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

  25.    [((~and op rec) v:id lhs:expr)
    26. 

  26.     (quasisyntax/loc stx
    27. 

  27.       (op v #,(re-expand #'lhs)))]
    28. 

  28.    [((~and op unquote) e:expr)
    29. 

  29.     (quasisyntax/loc stx
    30. 

  30.       (op e))]
    31. 

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

  32.     (quasisyntax/loc stx
    33. 

  33.       (op #,(re-expand #'lhs)))]
    34. 

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

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

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

  37.     (quasisyntax/loc stx
    38. 

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

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

  40.     (quasisyntax/loc stx
    41. 

  41.       #,(re-expand #'(op lhs (op rest ...))))]
    42. 

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

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

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

  45.     (quasisyntax/loc stx
    46. 

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

  47.    [((~and op union) lhs:expr rest:expr ...)
    48. 

  48.     (quasisyntax/loc stx
    49. 

  49.       #,(re-expand #'(op lhs (op rest ...))))]
    50. 

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

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

  52.     (quasisyntax/loc stx
    53. 

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

  54.    [(~and e ((~var transformer (static re-transformer? "re transformer")) . _))
    55. 

  55.     (record-disappeared-uses (list #'transformer))
    56. 

  56.     (quasisyntax/loc stx
    57. 

  57.       #,(re-expand ((re-transformer->re (attribute transformer.value)) #'e)))]
    58. 

  58.    [((~and op dseq) pat:expr rhs:expr)
    59. 

  59.     (quasisyntax/loc stx
    60. 

  60.       (op pat #,(re-expand #'rhs)))]
    61. 

  61.    [_
    62. 

  62.     stx]))
    63. 

  63. 

  64. (define-for-syntax (re-compile stx)
    65. 

  65.   (syntax-parse
    66. 

  66.    stx
    67. 

  67.    [the-re:sre
    68. 

  68.     (attribute the-re.best)]))
    69. 

  69. 

  70. (define-syntax (re stx)
    71. 

  71.   (with-disappeared-uses
    72. 

  72.       (syntax-case stx ()
    73. 

  73.         [(_ the-re)
    74. 

  74.          (re-compile (re-expand #'the-re))])))
    75. 

    76. 

  76. (provide
    77. 

  77.  complement seq union star epsilon nullset dseq rec unquote
    78. 

  78.  define-re-transformer
    79. 

  79.  re)
    80. 

  80.