Posted to tcl by evilotto at Mon Jul 15 21:58:00 GMT 2013view raw

  1. driver:
  2. package require pt::peg::from::peg
  3. package require pt::peg::container
  4. package require pt::peg::interp
  5. package require pt::ast
  6.  
  7. set f [open [lindex $argv 0]]
  8. set ldef [read $f]
  9. close $f
  10.  
  11. set stream [open [lindex $argv 1]]
  12.  
  13. pt::peg::container lang
  14. pt::peg::interp L
  15. lang deserialize = [pt::peg::from::peg convert $ldef]
  16. L use lang
  17.  
  18. set ast [L parse $stream]
  19.  
  20. seek $stream 0
  21. set data [read $stream]
  22.  
  23. proc exp_ast_nt {a} {
  24. if {[llength $a] == 3} {
  25. return [list [string range $::data [lindex $a 1] [lindex $a 2]]]
  26. } else {
  27. return [list {*}[lmap st [lrange $a 3 end] {exp_ast_nt $st}]]
  28. }
  29. }
  30.  
  31. proc exp_ast {a} {
  32. if {[llength $a] == 3} {
  33. return [list [lindex $a 0] [string range $::data [lindex $a 1] [lindex $a 2]]]
  34. } else {
  35. return [list [lindex $a 0] {*}[lmap st [lrange $a 3 end] {exp_ast $st}]]
  36. }
  37. }
  38.  
  39. foreach r [exp_ast $ast] { puts $r}
  40.  
  41. puts "\nsimple:"
  42. foreach r [exp_ast_nt $ast] { puts $r}
  43.  
  44.  
  45. Grammar:
  46. PEG harzilein (command)
  47. command <- cmdname S* '{' S* operation? (S* ';' S* operation?)* '}' ;
  48. operation <- assignment / command ;
  49. assignment <- varname S* '=' S* multivalue ;
  50. multivalue <- assignment / value;
  51.  
  52. leaf: cmdname <- ident ;
  53. leaf: varname <- ident ;
  54. leaf: value <- ident ;
  55. ident <- ('_' / <alnum>)+ ;
  56. void: S <- <space> ;
  57. END;
  58.  
  59. Language test:
  60. command { foo = bar ; bar = baz ; nested_bar {foo=quux = quuuux}}
  61.  
  62. Result:
  63. command
  64. cmdname command
  65. operation {assignment {varname foo} {multivalue {value bar}}}
  66. operation {assignment {varname bar} {multivalue {value baz}}}
  67. operation {command {cmdname nested_bar} {operation {assignment {varname foo} {multivalue {assignment {varname quux} {multivalue {value quuuux}}}}}}}
  68.  
  69. simple:
  70. command
  71. {foo bar}
  72. {bar baz}
  73. {nested_bar {{foo {{quux quuuux}}}}}
  74.