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

Related to #358.

diff --git a/extra/gml/b-rep/b-rep.factor b/extra/gml/b-rep/b-rep.factor
index b946793294008d1cd6b74f66afe7700ab1080357..cd3609391fc9f1ce52727cdeb90604159b3ceb0f 100644 (file)
--- a/extra/gml/b-rep/b-rep.factor
+++ b/extra/gml/b-rep/b-rep.factor
@@ -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 ;

diff --git a/extra/gml/core/core.factor b/extra/gml/core/core.factor
index dec8142cc2064db1e2bdaf24f5ce64d9dc07cd45..8d49087c8b037fdaf27cc6b4d0e2a29af0eba5b4 100644 (file)
--- a/extra/gml/core/core.factor
+++ b/extra/gml/core/core.factor
@@ -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 ;

diff --git a/extra/gml/parser/parser.factor b/extra/gml/parser/parser.factor
index c142541b69c93e226d6b75a8b394e4e5f8166395..f815330eea53daa15aa28160ffe30b5df78fb7e7 100644 (file)
--- a/extra/gml/parser/parser.factor
+++ b/extra/gml/parser/parser.factor
@@ -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

diff --git a/extra/gml/printer/printer.factor b/extra/gml/printer/printer.factor
index 48b5ac9d36c4bbd5472f08c09326acf47e8744a5..4e1d4f67e6831153a0e9ed99e382b8e8ea57a6bd 100644 (file)
--- a/extra/gml/printer/printer.factor
+++ b/extra/gml/printer/printer.factor
@@ -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 ;

diff --git a/extra/gml/runtime/runtime.factor b/extra/gml/runtime/runtime.factor
index 798de511e401feb523c35358bb4e2778b1d136c6..123b47475bd5edd949fe6c8a855dad1379f08209 100644 (file)
--- a/extra/gml/runtime/runtime.factor
+++ b/extra/gml/runtime/runtime.factor
@@ -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 ]