extra/gml/parser/parser.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 USING: accessors kernel arrays strings math.parser peg peg.ebnf
   3 multiline gml.types gml.runtime sequences sequences.deep locals
   4 combinators math ;
   5 IN: gml.parser
   6
   7 TUPLE: comment string ;
   8
   9 C: <comment> comment
  10
  11 : register-index ( name registers -- n )
  12     2dup index dup [ 2nip ] [ drop [ nip length ] [ push ] 2bi ] if ;
  13
  14 : resolve-register ( insn registers -- )
  15     [ dup name>> ] dip register-index >>n drop ;
  16
  17 ERROR: missing-usereg ;
  18
  19 :: (resolve-registers) ( array registers -- ? )
  20     f :> use-registers!
  21     array [
  22         {
  23             { [ dup use-registers? ] [ use-registers! ] }
  24             { [ dup read-register? ] [ registers resolve-register ] }
  25             { [ dup exec-register? ] [ registers resolve-register ] }
  26             { [ dup write-register? ] [ registers resolve-register ] }
  27             { [ dup proc? ] [
  28                 dup [ use-registers? ] any? [ drop ] [
  29                     array>> registers (resolve-registers) drop
  30                 ] if
  31             ] }
  32             [ drop ]
  33         } cond
  34     ] each
  35     use-registers ;
  36
  37 :: resolve-registers ( array -- )
  38     V{ } clone :> registers
  39     array [ use-registers? ] any? [
  40         array registers (resolve-registers)
  41         registers length >>n drop
  42     ] when ;
  43
  44 : parse-proc ( array -- proc )
  45     >array [ resolve-registers ] [ { } <proc> ] bi ;
  46
  47 ERROR: bad-vector-length seq n ;
  48
  49 : parse-vector ( seq -- vec )
  50     dup length {
  51         { 2 [ first2 <vec2d> ] }
  52         { 3 [ first3 <vec3d> ] }
  53         [ bad-vector-length ]
  54     } case ;
  55
  56 EBNF: parse-gml [=[
  57
  58 Letter = [a-zA-Z]
  59 Digit = [0-9]
  60 Digits = Digit+
  61
  62 Sign = ('+' => [[ first ]]|'-' => [[ first ]])?
  63
  64 StopChar = ('('|')'|'['|']'|'{'|'}'|'/'|'/'|';'|':'|'!'|'.')
  65
  66 Space = [ \t\n\r]
  67
  68 Spaces = Space* => [[ ignore ]]
  69
  70 Newline = [\n\r]
  71
  72 Number = Sign Digit+ ('.' => [[ first ]] Digit+)? ('e' => [[ first ]] Sign Digit+)?
  73     => [[ flatten sift >string string>number ]]
  74
  75 VectorComponents = (Number:f Spaces ',' Spaces => [[ f ]])*:fs Number:f Spaces => [[ fs f suffix ]]
  76
  77 Vector = '(' Spaces VectorComponents ')' => [[ second parse-vector ]]
  78
  79 StringChar = !('"').
  80
  81 String = '"' StringChar+:s '"' => [[ s >string ]]
  82
  83 NameChar = !(Space|StopChar).
  84
  85 Name = NameChar+ => [[ >string ]]
  86
  87 Comment = ('%' (!(Newline) .)* (Newline|!(.))) => [[ <comment> ]]
  88
  89 ArrayStart = '[' => [[ marker ]]
  90
  91 ArrayEnd = ']' => [[ exec" ]" ]]
  92
  93 ExecArray = '{' Token*:ts Spaces '}' => [[ ts parse-proc ]]
  94
  95 LiteralName = '/' Name:n => [[ n >gml-name ]]
  96
  97 UseReg = "usereg" !(NameChar) => [[ <use-registers> ]]
  98
  99 ReadReg = ";" Name:n => [[ n <read-register> ]]
 100 ExecReg = ":" Name:n => [[ n <exec-register> ]]
 101 WriteReg = "!" Name:n => [[ n <write-register> ]]
 102
 103 ExecName = Name:n => [[ n >gml-exec-name ]]
 104
 105 PathNameComponent = "." Name:n => [[ n >gml-name ]]
 106 PathName = PathNameComponent+ => [[ <pathname> ]]
 107
 108 Token = Spaces
 109     (Comment |
 110      Number |
 111      Vector |
 112      String |
 113      ArrayStart |
 114      ArrayEnd |
 115      ExecArray |
 116      LiteralName |
 117      UseReg |
 118      ReadReg |
 119      ExecReg |
 120      WriteReg |
 121      ExecName |
 122      PathName)
 123
 124 Tokens = Token* => [[ [ comment? ] reject ]]
 125
 126 Program = Tokens Spaces !(.) => [[ parse-proc ]]
 127
 128 ]=]