extra/gml/parser/parser.factor

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