steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

gml.runtime: Don't let gml double up on class/word names. 

Related to #358.
char-rename
Doug Coleman 2017-06-01 15:19:11 -05:00
parent 88bff3a034
commit f7ce73b962
5 changed files with 21 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/gml/b-rep/b-rep.factor
View File

@ -83,12 +83,12 @@ GML: isValidEdge ( e -- ? ) b-rep get is-valid-edge? ;
GML: materialF ( e material -- ) material-f ;
GML: setcurrentmaterial ( material -- ) drop ;
GML: getcurrentmaterial ( -- material ) "none" name ;
GML: getcurrentmaterial ( -- material ) "none" >gml-name ;
GML: pushcurrentmaterial ( material -- ) drop ;
GML: popcurrentmaterial ( -- material ) "none" name ;
GML: popcurrentmaterial ( -- material ) "none" >gml-name ;
GML: getmaterialnames ( -- [material] ) { } ;
GML: setfacematerial ( e material -- ) material-f ;
GML: getfacematerial ( e -- material ) drop "none" name ;
GML: getfacematerial ( e -- material ) drop "none" >gml-name ;
GML: setsharpness ( sharp -- ) c-bool> set-sharpness ;
GML: getsharpness ( -- sharp ) get-sharpness >c-bool ;

2
extra/gml/core/core.factor
View File

@ -107,7 +107,7 @@ GML: load ( name -- value ) over lookup-name ;
ERROR: not-a-name object ;
: check-name ( obj -- obj' ) dup name? [ not-a-name ] unless ; inline
: check-name ( obj -- obj' ) dup gml-name? [ not-a-name ] unless ; inline
GML: def ( name value -- ) swap check-name pick current-dict set-at ;
GML: edef ( value name -- ) check-name pick current-dict set-at ;

6
extra/gml/parser/parser.factor
View File

@ -91,7 +91,7 @@ ArrayEnd = ']' => [[ exec" ]" ]]
ExecArray = '{' Token*:ts Spaces '}' => [[ ts parse-proc ]]
LiteralName = '/' Name:n => [[ n name ]]
LiteralName = '/' Name:n => [[ n >gml-name ]]
UseReg = "usereg" !(NameChar) => [[ <use-registers> ]]
@ -99,9 +99,9 @@ ReadReg = ";" Name:n => [[ n <read-register> ]]
ExecReg = ":" Name:n => [[ n <exec-register> ]]
WriteReg = "!" Name:n => [[ n <write-register> ]]
ExecName = Name:n => [[ n exec-name ]]
ExecName = Name:n => [[ n >gml-exec-name ]]
PathNameComponent = "." Name:n => [[ n name ]]
PathNameComponent = "." Name:n => [[ n >gml-name ]]
PathName = PathNameComponent+ => [[ <pathname> ]]
Token = Spaces

4
extra/gml/printer/printer.factor
View File

@ -10,8 +10,8 @@ M: object write-gml "«Object: " write name>> write "»" write ;
M: integer write-gml number>string write ;
M: float write-gml number>string write ;
M: string write-gml "\"" write write "\"" write ;
M: name write-gml "/" write string>> write ;
M: exec-name write-gml name>> string>> write ;
M: gml-name write-gml "/" write string>> write ;
M: gml-exec-name write-gml name>> string>> write ;
M: pathname write-gml names>> [ "." write string>> write ] each ;
M: use-registers write-gml drop "usereg" write ;
M: read-register write-gml ";" write name>> write ;

24
extra/gml/runtime/runtime.factor
View File

@ -6,13 +6,13 @@ vectors words generalizations sequences.generalizations
effects.parser gml.types ;
IN: gml.runtime
TUPLE: name < identity-tuple { string read-only } ;
TUPLE: gml-name < identity-tuple { string read-only } ;
SYMBOL: names
SYMBOL: gml-names
names [ H{ } clone ] initialize
gml-names [ H{ } clone ] initialize
: name ( string -- name ) names get-global [ \ name boa ] cache ;
: >gml-name ( string -- name ) gml-names get-global [ \ gml-name boa ] cache ;
TUPLE: gml { operand-stack vector } { dictionary-stack vector } ;
@ -49,13 +49,13 @@ EXEC: object over push-operand ;
EXEC: proc array>> pick <proc> over push-operand ;
! Executable names
TUPLE: exec-name < identity-tuple name ;
TUPLE: gml-exec-name < identity-tuple name ;
MEMO: exec-name ( string -- name ) name \ exec-name boa ;
MEMO: >gml-exec-name ( string -- name ) >gml-name \ gml-exec-name boa ;
SYNTAX: exec" lexer get skip-blank parse-string exec-name suffix! ;
SYNTAX: exec" lexer get skip-blank parse-string >gml-exec-name suffix! ;
ERROR: unbound-name { name name } ;
ERROR: unbound-name { name gml-name } ;
: lookup-name ( name gml -- value )
dupd dictionary-stack>> assoc-stack
@ -77,7 +77,7 @@ M: word exec-proc primitive-effect execute-effect-unsafe ;
M: object exec-proc (exec) ;
EXEC: exec-name name>> over lookup-name exec-proc ;
EXEC: gml-exec-name name>> over lookup-name exec-proc ;
! Registers
ERROR: unbound-register name ;
@ -129,8 +129,8 @@ EXEC:: pathname ( registers gml obj -- registers gml )
registers gml ;
! List building and stuff
TUPLE: marker < identity-tuple ;
CONSTANT: marker T{ marker }
TUPLE: gml-marker < identity-tuple ;
CONSTANT: marker T{ gml-marker }
ERROR: no-marker-found ;
ERROR: gml-stack-underflow ;
@ -177,7 +177,7 @@ SYMBOL: global-dictionary
global-dictionary [ H{ } clone ] initialize
: add-primitive ( word name -- )
name global-dictionary get-global set-at ;
>gml-name global-dictionary get-global set-at ;
: define-gml-primitive ( word name effect def -- )
[ '[ _ add-primitive ] keep ]