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 ;
6 TUPLE: comment string ;
10 : register-index ( name registers -- n )
11 2dup index dup [ 2nip ] [ drop [ nip length ] [ push ] 2bi ] if ;
13 : resolve-register ( insn registers -- )
14 [ dup name>> ] dip register-index >>n drop ;
16 ERROR: missing-usereg ;
18 :: (resolve-registers) ( array registers -- ? )
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 ] }
27 dup [ use-registers? ] any? [ drop ] [
28 array>> registers (resolve-registers) drop
36 :: resolve-registers ( array -- )
37 V{ } clone :> registers
38 array [ use-registers? ] any? [
39 array registers (resolve-registers)
40 registers length >>n drop
43 : parse-proc ( array -- proc )
44 >array [ resolve-registers ] [ { } <proc> ] bi ;
46 ERROR: bad-vector-length seq n ;
48 : parse-vector ( seq -- vec )
50 { 2 [ first2 <vec2d> ] }
51 { 3 [ first3 <vec3d> ] }
61 Sign = ('+' => [[ first ]]|'-' => [[ first ]])?
63 StopChar = ('('|')'|'['|']'|'{'|'}'|'/'|'/'|';'|':'|'!'|'.')
65 Space = ' ' | '\t' | '\r' | '\n'
67 Spaces = Space* => [[ ignore ]]
69 Newline = ('\n' | '\r')
71 Number = Sign Digit+ ('.' => [[ first ]] Digit+)? ('e' => [[ first ]] Sign Digit+)?
72 => [[ flatten sift >string string>number ]]
74 VectorComponents = (Number:f Spaces ',' Spaces => [[ f ]])*:fs Number:f Spaces => [[ fs f suffix ]]
76 Vector = '(' Spaces VectorComponents ')' => [[ second parse-vector ]]
80 String = '"' StringChar+:s '"' => [[ s >string ]]
82 NameChar = !(Space|StopChar).
84 Name = NameChar+ => [[ >string ]]
86 Comment = ('%' (!(Newline) .)* (Newline|!(.))) => [[ <comment> ]]
88 ArrayStart = '[' => [[ marker ]]
90 ArrayEnd = ']' => [[ exec" ]" ]]
92 ExecArray = '{' Token*:ts Spaces '}' => [[ ts parse-proc ]]
94 LiteralName = '/' Name:n => [[ n name ]]
96 UseReg = "usereg" !(NameChar) => [[ <use-registers> ]]
98 ReadReg = ";" Name:n => [[ n <read-register> ]]
99 ExecReg = ":" Name:n => [[ n <exec-register> ]]
100 WriteReg = "!" Name:n => [[ n <write-register> ]]
102 ExecName = Name:n => [[ n exec-name ]]
104 PathNameComponent = "." Name:n => [[ n name ]]
105 PathName = PathNameComponent+ => [[ <pathname> ]]
123 Tokens = Token* => [[ [ comment? ] reject ]]
125 Program = Tokens Spaces !(.) => [[ parse-proc ]]