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