diff --git a/extra/gml/b-rep/b-rep.factor b/extra/gml/b-rep/b-rep.factor index b946793294..cd3609391f 100644 --- 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 dec8142cc2..8d49087c8b 100644 --- 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 c142541b69..f815330eea 100644 --- 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) => [[ ]] @@ -99,9 +99,9 @@ ReadReg = ";" Name:n => [[ n ]] ExecReg = ":" Name:n => [[ n ]] WriteReg = "!" Name:n => [[ n ]] -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+ => [[ ]] Token = Spaces diff --git a/extra/gml/printer/printer.factor b/extra/gml/printer/printer.factor index 48b5ac9d36..4e1d4f67e6 100644 --- 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 798de511e4..123b47475b 100644 --- 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 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 ]