basis/peg/parsers/parsers.factor

   1 ! Copyright (C) 2007, 2008 Chris Double, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors fry kernel literals make math math.parser
   4 math.ranges peg peg.private sequences splitting strings unicode
   5 vectors ;
   6 FROM: peg.search => replace ;
   7 IN: peg.parsers
   8
   9 TUPLE: just-parser p1 ;
  10
  11 CONSTANT: just-pattern [
  12     dup [
  13         dup remaining>> empty? [ drop f ] unless
  14     ] when
  15 ]
  16
  17 M: just-parser (compile)
  18     p1>> compile-parser-quot just-pattern compose ;
  19
  20 : just ( parser -- parser )
  21     just-parser boa wrap-peg ;
  22
  23 : 1token ( ch -- parser ) 1string token ;
  24
  25 : (list-of) ( items separator repeat1? -- parser )
  26     [ over 2seq ] dip [ repeat1 ] [ repeat0 ] if
  27     [ concat ] action 2seq
  28     [ unclip 1vector swap first append ] action ;
  29
  30 : list-of ( items separator -- parser )
  31     hide f (list-of) ;
  32
  33 : list-of-many ( items separator -- parser )
  34     hide t (list-of) ;
  35
  36 CONSTANT: epsilon $[ V{ } token ]
  37
  38 CONSTANT: any-char $[ [ drop t ] satisfy ]
  39
  40 <PRIVATE
  41
  42 : flatten-vectors ( pair -- vector )
  43     first2 append! ;
  44
  45 PRIVATE>
  46
  47 : exactly-n ( parser n -- parser' )
  48     swap <repetition> seq ;
  49
  50 : at-most-n ( parser n -- parser' )
  51     [
  52         drop epsilon
  53     ] [
  54         [ exactly-n ] [ 1 - at-most-n ] 2bi 2choice
  55     ] if-zero ;
  56
  57 : at-least-n ( parser n -- parser' )
  58     dupd exactly-n swap repeat0 2seq
  59     [ flatten-vectors ] action ;
  60
  61 : from-m-to-n ( parser m n -- parser' )
  62     [ [ exactly-n ] 2keep ] dip swap - at-most-n 2seq
  63     [ flatten-vectors ] action ;
  64
  65 : pack ( begin body end -- parser )
  66     [ hide ] [ ] [ hide ] tri* 3seq [ first ] action ;
  67
  68 : surrounded-by ( parser begin end -- parser' )
  69     [ token ] bi@ swapd pack ;
  70
  71 : digit-parser ( -- parser )
  72     [ digit? ] satisfy [ digit> ] action ;
  73
  74 : integer-parser ( -- parser )
  75     [ digit? ] satisfy repeat1 [ string>number ] action ;
  76
  77 : string-parser ( -- parser )
  78     [
  79         [ CHAR: \" = ] satisfy hide ,
  80         [ CHAR: \" = not ] satisfy repeat0 ,
  81         [ CHAR: \" = ] satisfy hide ,
  82     ] seq* [ first >string ] action ;
  83
  84 : (range-pattern) ( pattern -- string )
  85     ! Given a range pattern, produce a string containing
  86     ! all characters within that range.
  87     [
  88         any-char ,
  89         [ CHAR: - = ] satisfy hide ,
  90         any-char ,
  91     ] seq* [
  92         first2 [a,b] >string
  93     ] action replace ;
  94
  95 : range-pattern ( pattern -- parser )
  96     ! 'pattern' is a set of characters describing the
  97     ! parser to be produced. Any single character in
  98     ! the pattern matches that character. If the pattern
  99     ! begins with a ^ then the set is negated (the element
 100     ! matches any character not in the set). Any pair of
 101     ! characters separated with a dash (-) represents the
 102     ! range of characters from the first to the second,
 103     ! inclusive.
 104     "^" ?head [
 105         (range-pattern) '[ _ member? not ] satisfy
 106     ] [
 107         (range-pattern) '[ _ member? ] satisfy
 108     ] if ;