factor/extra/gml/gml.factor

70 lines
1.5 KiB
Factor
Raw Normal View History

2013-06-18 19:42:13 -04:00
! Copyright (C) 2010 Slava Pestov.
USING: accessors continuations debugger fry io io.encodings.utf8
io.files kernel namespaces sequences euler.b-rep euler.operators
gml.core gml.coremath gml.b-rep gml.geometry gml.modeling
gml.parser gml.printer gml.runtime gml.viewer ;
IN: gml
TUPLE: gml-file-error pathname error ;
C: <gml-file-error> gml-file-error
M: gml-file-error error.
"Error in GML file “" write
dup pathname>> write "”:" print nl
error>> error. ;
: gml-stack. ( gml -- )
operand-stack>> [
"Operand stack:" print
[ "• " write print-gml ] each
] unless-empty ;
SYMBOL: gml
: make-gml ( quot -- gml b-rep )
[
<gml> gml set
<b-rep> b-rep set
call
gml get
b-rep get dup finish-b-rep
] with-scope ; inline
: with-gml ( gml b-rep quot -- )
[
[ gml set ]
[ b-rep set ]
[ call ]
tri*
] with-scope ; inline
: run-gml-string ( string -- )
[ gml get ] dip parse-gml exec drop ;
: run-gml-file ( pathname -- )
[ utf8 file-contents run-gml-string ]
[ <gml-file-error> rethrow ]
recover ;
SYMBOLS: pre-hook post-hook ;
[ ] pre-hook set-global
[ ] post-hook set-global
: (gml-listener) ( -- )
"GML> " write flush readln [
'[
pre-hook get call( -- )
_ run-gml-string
post-hook get call( -- )
] try
[ gml get gml-stack. ] try
(gml-listener)
] when* ;
: gml-listener ( -- )
[ (gml-listener) ] make-gml 2drop ;
MAIN: gml-listener