├── .gitignore ├── COPYING ├── Makefile ├── README ├── compiler ├── compile.topaz ├── expressions.topaz ├── natives.topaz └── test.topaz ├── next ├── actions.topaz ├── docs │ └── t--.txt ├── internal-actions.topaz ├── symbols.topaz └── types │ ├── block.topaz │ ├── datatype.topaz │ └── value.topaz └── topaz ├── actions.topaz ├── compile-topaz.topaz ├── compiler.topaz ├── concepts.rmd ├── init.topaz ├── load.topaz ├── natives.topaz ├── support.topaz ├── tests ├── blocks-results.topaz ├── blocks.topaz ├── compiler-results.topaz ├── compiler.topaz ├── contexts-results.topaz ├── contexts.topaz ├── errors-results.topaz ├── errors.topaz ├── functions-results.topaz ├── functions.topaz ├── natives-results.topaz ├── natives.topaz ├── objects-results.topaz ├── objects.topaz ├── parse-results.topaz ├── parse.topaz ├── paths-results.topaz ├── paths.topaz ├── run.topaz ├── scalars-results.topaz ├── scalars.topaz ├── strings-results.topaz ├── strings.topaz ├── typesets-results.topaz ├── typesets.topaz ├── words-results.topaz └── words.topaz ├── try-topaz.html ├── types ├── action.topaz ├── block.topaz ├── char.topaz ├── context.topaz ├── datatype.topaz ├── error.topaz ├── expression.topaz ├── file.topaz ├── function.topaz ├── get-word.topaz ├── lit-path.topaz ├── lit-word.topaz ├── logic.topaz ├── native.topaz ├── none.topaz ├── number.topaz ├── object.topaz ├── op.topaz ├── paren.topaz ├── path.topaz ├── return-value.topaz ├── return.topaz ├── set-path.topaz ├── set-word.topaz ├── string.topaz ├── throw.topaz ├── typeset.topaz └── word.topaz └── typesets.topaz /.gitignore: -------------------------------------------------------------------------------- 1 | JR 2 | *~ 3 | *.swp 4 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | Copyright 2011 Gabriele Santilli 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining 4 | a copy of this software and associated documentation files 5 | (the "Software"), to deal in the Software without restriction, including 6 | without limitation the rights to use, copy, modify, merge, publish, 7 | distribute, sublicense, and/or sell copies of the Software, and to 8 | permit persons to whom the Software is furnished to do so, subject 9 | to the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included 12 | in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 15 | OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 17 | THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 18 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 19 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 20 | OTHER DEALINGS IN THE SOFTWARE. 21 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | NODE = node 2 | NODEINT = rlwrap node 3 | 4 | all: topaz/topaz.js 5 | 6 | tests: topaz/topaz.js topaz/tests/* 7 | ${NODE} topaz/topaz.js topaz/tests/run.topaz 8 | 9 | repl: all 10 | ${NODEINT} topaz/topaz.js 11 | 12 | topaz/topaz.js: topaz/bootstrap.js topaz/actions.topaz topaz/compiler.topaz topaz/init.topaz topaz/load.topaz topaz/natives.topaz topaz/support.topaz topaz/typesets.topaz topaz/types/* topaz/compile-topaz.topaz 13 | ${NODE} topaz/bootstrap.js topaz/compile-topaz.topaz 14 | 15 | topaz/bootstrap.js: 16 | wget -O topaz/bootstrap.js http://www.colellachiara.com/soft/topaz/bootstrap.js 17 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | The bootstrap phase is complete. Topaz is capable of compiling 2 | itself into Javascript which can then be executed with node.js. 3 | The Makefile automatically downloads a bootstrap JS file for the 4 | initial compilation. 5 | 6 | More details about Topaz will be available soon. 7 | -------------------------------------------------------------------------------- /compiler/expressions.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Topaz compiler - Expression objects" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2012 5 | ; License: { 6 | ; Permission is hereby granted, free of charge, to any person obtaining 7 | ; a copy of this software and associated documentation files 8 | ; (the "Software"), to deal in the Software without restriction, including 9 | ; without limitation the rights to use, copy, modify, merge, publish, 10 | ; distribute, sublicense, and/or sell copies of the Software, and to 11 | ; permit persons to whom the Software is furnished to do so, subject 12 | ; to the following conditions: 13 | 14 | ; The above copyright notice and this permission notice shall be included 15 | ; in all copies or substantial portions of the Software. 16 | 17 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 18 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 20 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 21 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 22 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 23 | ; OTHER DEALINGS IN THE SOFTWARE. 24 | ; } 25 | ] 26 | 27 | probe-expression: func [ 28 | "Print a human-readable representation of an expression object" 29 | expression [object!] 30 | 31 | return: expression [object!] 32 | ] [ 33 | print expression/mold expression 34 | expression 35 | ] 36 | 37 | mold-expr: func [expr] [expr/mold expr] 38 | 39 | evaluate-expression: func [environment expression] [ 40 | expression/evaluate environment expression 41 | ] 42 | 43 | empty-environment: func [ 44 | "Return an empty environment" 45 | 46 | return: environment [block!] 47 | ] [ 48 | make block! none 49 | ] 50 | 51 | expression: object none [ 52 | mold: func [expr] ["(unknown expression)"] 53 | evaluate: func [env expr] [expr] 54 | call-function: func [env expr block] [cause-error "CALL-FUNCTION on non-function expression"] 55 | simplify: func [expr] [expr] 56 | ] 57 | 58 | empty-expression: object expression [ 59 | mold: func [expr] ["()"] 60 | ] 61 | 62 | body-expression: object expression [ 63 | io: [] 64 | environment: empty-environment 65 | result: empty-expression 66 | mold: func [expr] [ 67 | id: -1 68 | rejoin [ 69 | rejoin map 'var copy expr/environment [ 70 | id: id + 1 71 | rejoin ["(set $" id " " either var [mold-expr var] ["?"] ")^/"] 72 | ] 73 | "(return " mold-expr expr/result ")^/" 74 | ] 75 | ] 76 | ] 77 | 78 | quit-expression: object expression [ 79 | io: [] 80 | exit-code: empty-expression 81 | mold: func [expr] [ 82 | rejoin ["(quit " mold-expr expr/exit-code ")^/"] 83 | ] 84 | ] 85 | 86 | fundef-expr: object expression [ 87 | ; arguments: result of parse-arguments 88 | ; body: expression object for the function body 89 | ; -- 90 | fundef?: yes 91 | mold: func [expr] [ 92 | rejoin [ 93 | "function(" 94 | rejoin punctuate map 'arg copy expr/arguments [rejoin ["$" mold arg/var-id]] ", " 95 | ") (^/" 96 | mold-expr expr/body 97 | ")^/" 98 | ] 99 | ] 100 | call-function: func [environment expr block] [ 101 | compile-function-call environment expr block 102 | ] 103 | ] 104 | 105 | value-expr: object expression [ 106 | ; value: Topaz value 107 | ; -- 108 | mold: func [expr] [rejoin ["(value " mold expr/value ")"]] 109 | ] 110 | 111 | get-expr: object expression [ 112 | ; var-id: variable id 113 | ; -- 114 | evaluate: func [environment expression] [ 115 | any [ 116 | pick environment expression/var-id 117 | expression 118 | ] 119 | ] 120 | mold: func [expr] [rejoin ["(get $" mold expr/var-id ")"]] 121 | ] 122 | 123 | op-expr: object expression [ 124 | ; op: operator function 125 | ; expr1: expression 1 126 | ; expr2: expression 2 127 | ; -- 128 | evaluate: func [environment expression] [ 129 | object expression [ 130 | expr1: evaluate-expression environment expression/expr1 131 | expr2: evaluate-expression environment expression/expr2 132 | ] 133 | ] 134 | mold: func [expr] [ 135 | rejoin ["(op " mold-expr expr/expr1 " " mold-expr expr/expr2 ")"] 136 | ] 137 | ] 138 | 139 | native-fundef: object expression [ 140 | call-function: func [ 141 | environment expr block 142 | 143 | return: environment result block 144 | ] [ 145 | args: make block! none 146 | set this-context collect-arguments [ 147 | environment: environment 148 | arguments: expr/arguments 149 | block: next block 150 | each: func [ 151 | arg [object!] 152 | environment [block!] 153 | result [object!] 154 | 155 | return: environment [block!] 156 | ] [ 157 | append args result 158 | environment 159 | ] 160 | ] 161 | ; FIXME 162 | set [make-expression:] expr 163 | return environment apply/only :make-expression args block 164 | ] 165 | ] 166 | 167 | call-expr: object expression [ 168 | mold: func [expr] [ 169 | rejoin [ 170 | "(call " mold expr/name " " 171 | rejoin punctuate map 'arg copy expr/args [mold-expr arg] ", " 172 | ")" 173 | ] 174 | ] 175 | ] 176 | -------------------------------------------------------------------------------- /compiler/natives.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Topaz compiler - Compiler natives" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2012 5 | ; License: { 6 | ; Permission is hereby granted, free of charge, to any person obtaining 7 | ; a copy of this software and associated documentation files 8 | ; (the "Software"), to deal in the Software without restriction, including 9 | ; without limitation the rights to use, copy, modify, merge, publish, 10 | ; distribute, sublicense, and/or sell copies of the Software, and to 11 | ; permit persons to whom the Software is furnished to do so, subject 12 | ; to the following conditions: 13 | 14 | ; The above copyright notice and this permission notice shall be included 15 | ; in all copies or substantial portions of the Software. 16 | 17 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 18 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 20 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 21 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 22 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 23 | ; OTHER DEALINGS IN THE SOFTWARE. 24 | ; } 25 | ] 26 | 27 | foreach [name spec body] [ 28 | quit [ 29 | "Quit the Topaz interpreter" 30 | exit-code [object!] "Code to return to calling environment" 31 | ] [ 32 | object quit-expression [ 33 | exit-code: exit-code 34 | ] 35 | ] 36 | ] [ 37 | set-compiler-value name object native-fundef [ 38 | arguments: parse-arguments context [] spec 39 | make-expression: func spec body 40 | ] 41 | ] 42 | -------------------------------------------------------------------------------- /compiler/test.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Topaz compiler - Simple test" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2012 5 | ; License: { 6 | ; Permission is hereby granted, free of charge, to any person obtaining 7 | ; a copy of this software and associated documentation files 8 | ; (the "Software"), to deal in the Software without restriction, including 9 | ; without limitation the rights to use, copy, modify, merge, publish, 10 | ; distribute, sublicense, and/or sell copies of the Software, and to 11 | ; permit persons to whom the Software is furnished to do so, subject 12 | ; to the following conditions: 13 | 14 | ; The above copyright notice and this permission notice shall be included 15 | ; in all copies or substantial portions of the Software. 16 | 17 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 18 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 20 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 21 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 22 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 23 | ; OTHER DEALINGS IN THE SOFTWARE. 24 | ; } 25 | ] 26 | 27 | foreach 'file [ 28 | %compiler/expressions.topaz 29 | %compiler/compile.topaz 30 | %compiler/natives.topaz 31 | ] [ 32 | do file 33 | ] 34 | 35 | f: func [a b] [a + b] 36 | g: func [a b] [f a + b a - b] 37 | 38 | compile :g 'javascript 39 | 40 | compile :q 'javascript 41 | -------------------------------------------------------------------------------- /next/actions.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Definition of standard Topaz value actions" 3 | Author: "Gabriele Santilli" 4 | Version: ;1.0.0 5 | ] 6 | 7 | reflect: [ 8 | "Return a value's internal property" 9 | value 10 | field [word!] "Eg. a series' INDEX or LENGTH, a function's SPEC etc." 11 | 12 | return: field-value [any-type!] 13 | ] 14 | insert: [ 15 | "Insert a value at the current position of the series" 16 | series 17 | value [any-type!] 18 | options: 19 | only [logic!] "Insert series as a single value" 20 | 21 | return: series "Series just after the inserted value" 22 | ] 23 | skip: [ 24 | "Return the series at a new position" 25 | series 26 | amount [integer!] "Skip the specified number of values" 27 | 28 | return: series 29 | ] 30 | mold: [ 31 | "Return a LOAD-able text representation of a value" 32 | value 33 | options: 34 | only [logic!] "Don't generate outer [ ] for block! values" 35 | flat [logic!] "Produce a single text line" 36 | limit: none [integer! none!] "Don't return a string longer than LIMIT characters" 37 | indent: "" [string!] "Add this string after each new line (ignored if flat)" 38 | 39 | return: text [string!] 40 | ] 41 | bind: [ 42 | "Bind words to a specified context" 43 | words 44 | context [context!] 45 | options: 46 | copy [logic!] "Bind a (deep) copy of WORDS" 47 | new [logic!] "Add all words to CONTEXT" 48 | 49 | return: words 50 | ] 51 | -------------------------------------------------------------------------------- /next/docs/t--.txt: -------------------------------------------------------------------------------- 1 | Topaz: The T-- dialect 2 | 3 | Author: "Gabriele Santilli" 4 | 5 | ===Introduction 6 | 7 | The T-- dialect is the language used for the implementation of the lower 8 | level layers of Topaz (for example, datatype actions). For this reason, 9 | it is a rather low level, statically typed language. 10 | 11 | ===Action definitions 12 | 13 | The list of standard actions defined for Topaz values is in the file 14 | topaz/actions.topaz. The file contain, for each action, the action name 15 | followed by the arguments specification block. The latter has the usual 16 | syntax, with the exception that the first argument has no explicit type 17 | checking (if provided, it is ignored). (Type of values that don't define 18 | a specific action, will just cause an error if that action is invoked.) 19 | 20 | ---Internal actions 21 | 22 | topaz/internal-actions.topaz defines additional actions that are used 23 | internally by Topaz but are not exposed to users. 24 | 25 | ===Value properties 26 | 27 | Each type of value defines a list of properties that are internally available 28 | for those values. These properties have "lower level" types which are only 29 | available within T--. 30 | 31 | The property types available within T-- are: 32 | 33 | int! (64 bit integer value) 34 | i32! (32 bit integer value) 35 | i16! (16 bit integer value) 36 | flt! (IEEE floating point value) 37 | chr! (single Unicode character) 38 | bit! (true or false) 39 | byt! (unsigned 8 bit integer value) 40 | 41 | There are also composite types: 42 | 43 | val! (Topaz value - has a type and properties depending on the type) 44 | array of x (a sequence of values of type x) 45 | map from x to y (a data structure that maps values of type x into values of type y) 46 | 47 | str! is an alias for "array of chr!", while bin! is an alias for "array of byt!". 48 | Please note that composite types are mutable. 49 | 50 | For example, the block! type defines its properties as: 51 | 52 | properties: [ 53 | values: array of val! 54 | pos: int! 55 | ] 56 | 57 | ===Value makers 58 | 59 | Types have a "maker" function that is responsible for constructing a value 60 | (ie. appropriately initializing its properties). MAKE only takes two 61 | arguments (type and "specification"), while makers may take any number 62 | of arguments; thus the rule for matching the specification to the maker 63 | arguments are as follows: 64 | 65 | *If the maker takes no arguments, then the specification is simply ignored. 66 | 67 | *If the maker takes exactly one argument, the specification is passed as is. 68 | 69 | *If the maker takes more than one argument, the specification must be a block, 70 | and its values are passed to the maker in order. 71 | 72 | Makers return a block containing pairs of set-words and expressions; these 73 | are used to initialize the properties of the new value being constructed. 74 | 75 | ===Standard actions 76 | 77 | The actions block in the type definition lists all the action functions 78 | for values of that type. The spec of each function has to match with how 79 | the action has been defined in the action definitions (topaz/actions.topaz), 80 | with the following accepted differences: 81 | 82 | *The mandatory arguments may be renamed for the sake of readability (provided 83 | there are no name clashes with the options of course). 84 | 85 | *Optional arguments don't need to be specified as options (it really makes no 86 | sense to). 87 | 88 | *Except for the first argument (whose type is obviously going to be the one 89 | being defined, or one based on it if the action hasn't been overridden), all 90 | other arguments may specify a T-- type instead of the original type in the 91 | action definition, provided there is a conversion defined from the type(s) 92 | in the action definition to the one used in the actual function. 93 | 94 | Remember that, since T-- is statically typed, you cannot specify multiple 95 | types for an argument. If the action definition accepts multiple types, 96 | you can either use val! and then use switch-type to act based on the type 97 | (or, simply use actions on that value so that there is a dynamic dispatch), 98 | or use a type for which there is a conversion for all the provided types. 99 | 100 | It is also possible for the type-specific action to be more restrictive 101 | in the types than the action definition, in which case an error is caused 102 | if an unsupported type is passed; it is however preferable to act in a way 103 | that makes sense rather than causing an error. (The stress being on "that makes 104 | sense" - don't surprise users, don't do things that may cause subtle bugs, etc.) 105 | 106 | ===T-- "native" functions 107 | 108 | These are the functions which are predefined in T--: 109 | 110 | to: [ 111 | "Convert a value to a different type" 112 | type "A T-- type name (can't be a composite)" 113 | value "A T-- value or a val!" 114 | 115 | ; if value is a val!, the conversion function defined for its type 116 | ; are used 117 | ] 118 | make: [ 119 | "Create a new val! value" 120 | type "A Topaz type name, or a val!" 121 | spec 122 | 123 | ; if type is a Topaz type name, the respective maker is invoked and passed 124 | ; the arguments in the spec. 125 | ; if it is a val!, it is cloned, and the clone is changed according to the 126 | ; spec 127 | ] 128 | switch-type: [ 129 | "Evaluate code depending on value's Topaz type" 130 | value 131 | cases "Literal block of cases" 132 | ] 133 | length-of: [ 134 | "Return length of array" 135 | array "T-- array" 136 | ] 137 | reduce: [ 138 | "Create a T-- array" 139 | expressions "Literal block of T-- expressions" 140 | 141 | ; all expressions need to have the same type 142 | ] 143 | switch-symbol: [ 144 | "Evaluate code depending on Topaz symbol ID" 145 | symbol-id 146 | cases "Literal block of cases" 147 | default "Literal block with default action" 148 | ] 149 | either: [ 150 | "Evaluate code based on condition" 151 | condition 152 | true-block "Literal block with true action" 153 | false-block "Literal block with false action" 154 | ] 155 | if: [ 156 | "Evaluate code if condition is true" 157 | condition 158 | code "Literal block with code" 159 | ] 160 | ; (maybe min and max should not be "natives") 161 | min: [ 162 | "Return minimum of two values" 163 | val1 164 | val2 165 | 166 | ; values must be of same type, there are no implicit conversions 167 | ; no composites 168 | ] 169 | max: [ 170 | "Return maximum of two values" 171 | val1 172 | val2 173 | 174 | ; see notes above 175 | ] 176 | shift-array: [ 177 | "Move values to the right in an array in order to make space" 178 | array 179 | starting-position "Move the value at this position and the ones which follow" 180 | amount "Amount to move by" 181 | 182 | ; eg. shift-array [1 2 3 4] 2 1 -> [1 2 _ 3 4] 183 | ] 184 | copy-array: [ 185 | "Create a new array out of the values from an existing array" 186 | array 187 | starting-position "Copy values from this position" 188 | length "Copy this number of values" 189 | ] 190 | for: [ 191 | "Generic loop function" 192 | init "Literal block of initialization" 193 | condition "Loop as long as this condition is true (literal block)" 194 | increment "Literal block with code to do after each iteration" 195 | code "Literal block of code" 196 | ] 197 | rejoin: [ 198 | "Join a list of strings" 199 | strings "Literal block that REDUCEs to strings" 200 | ] 201 | -------------------------------------------------------------------------------- /next/internal-actions.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Definition of internal Topaz value actions" 3 | Author: "Gabriele Santilli" 4 | Version: ;1.0.0 5 | ] 6 | 7 | do: [ 8 | value 9 | block [block!] 10 | 11 | return: 12 | result [any-type!] 13 | block [block!] 14 | ] 15 | get-path: [ 16 | value 17 | selector [any-type!] 18 | 19 | return: result [any-type!] 20 | ] 21 | set-path: [ 22 | value 23 | selector [any-type!] 24 | set-to [any-type!] 25 | 26 | return: set-to 27 | ] 28 | ;compile: [ 29 | ; value 30 | ; block [block!] 31 | ; 32 | ; return: 33 | ; ast-node [object!] 34 | ; block [block!] 35 | ;] 36 | -------------------------------------------------------------------------------- /next/symbols.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Definition of the global symbols table" 3 | Author: "Gabriele Santilli" 4 | Version: ;1.0.0 5 | ] 6 | 7 | symbols: [ 8 | by-id: array of (array of str!) 9 | by-word: map from str! to i32! 10 | by-spelling: map from str! to i16! 11 | ] 12 | support: [ 13 | str-to-symbol: func [ 14 | "Lookup a word into the symbol table (add if not present)" 15 | word [str!] 16 | 17 | return: 18 | symbol-id [i32!] "Symbol ID (case insensitive)" 19 | spelling-id [i16!] "Spelling ID (case sensitive)" 20 | ] [ 21 | ; cheating: JS lowercase function 22 | either symbol-id: symbols/by-word/(lowercase word) [ 23 | either spelling-id: symbols/by-spelling/(word) [ 24 | ; already in the symbols table 25 | return symbol-id spelling-id 26 | ] [ 27 | ; new spelling of an existing symbol 28 | spellings: symbols/by-id/(symbol-id) 29 | spelling-id: length-of spellings 30 | spellings/(spelling-id): word 31 | symbols/by-spelling/(word): spelling-id 32 | return symbol-id spelling-id 33 | ] 34 | ] [ 35 | symbol-id: length-of symbols/by-id 36 | symbols/by-id/(symbol-id): reduce [word] 37 | symbols/by-word/(lowercase word): symbol-id 38 | symbols/by-spelling/(word): 0 39 | return symbol-id 0 40 | ] 41 | ] 42 | symbol-to-str: func [ 43 | "Lookup a symbol into the symbol table" 44 | symbol-id [i32!] 45 | spelling-id [i16!] 46 | 47 | return: word [str!] 48 | ] [ 49 | symbols/by-id/(symbol-id)/(spelling-id) 50 | ] 51 | ] 52 | -------------------------------------------------------------------------------- /next/types/block.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Definition of BLOCK! values" 3 | Author: "Gabriele Santilli" 4 | Version: ;1.0.0 5 | Type: Datatype 6 | ] 7 | 8 | name: 'block! 9 | based-on: 'value! 10 | properties: [ 11 | values: array of val! 12 | pos: int! 13 | tail-newline?: bit! 14 | ] 15 | maker: func [] [ 16 | [ 17 | values: reduce [] 18 | pos: 0 19 | ] 20 | ] 21 | reflectors: [ 22 | index: [normalize value make integer! value/pos] 23 | length: [normalize value make integer! (length-of value/values) - value/pos] 24 | ] 25 | actions: [ 26 | insert: func [ 27 | block 28 | value [val!] 29 | only [bit!] 30 | 31 | return: block 32 | ] [ 33 | normalize block 34 | switch-type value [ 35 | any-block! [ 36 | either only [ 37 | len: 1 38 | insert-one block value 39 | ] [ 40 | normalize value 41 | len: (length-of value/values) - value/pos 42 | insert-many block value/values value/pos len 43 | ] 44 | ] 45 | any-type! [ 46 | len: 1 47 | insert-one block value 48 | ] 49 | ] 50 | make block [ 51 | pos: pos + len 52 | ] 53 | ] 54 | skip: func [ 55 | block 56 | amount [int!] 57 | 58 | return: block 59 | ] [ 60 | make block [ 61 | pos: max 0 min length-of block/values pos + amount 62 | ] 63 | ] 64 | mold: func [ 65 | block 66 | only [bit!] 67 | flat [bit!] 68 | limit [val!] 69 | indent [str!] 70 | 71 | return: text [str!] 72 | ] [ 73 | ; note: we're going to limit MOLD to 2GB 74 | switch-type limit [ 75 | integer! [lim: to int! limit] 76 | none! [lim: 2147483648] 77 | ] 78 | mold-values 79 | either only [""] ["["] ; open 80 | either only [""] [either block/tail-newline? [rejoin ["^/" indent "]"]] ["]"]] ; close 81 | " " ; sep 82 | flat ; flat 83 | either flat [" "] ["^/"] ; newline 84 | either flat [""] [rejoin [indent " "]] ; indent 85 | lim ; limit 86 | block/values ; values 87 | block/pos ; pos 88 | ] 89 | bind: func [ 90 | block 91 | context [val!] 92 | copy [bit!] 93 | new [bit!] 94 | 95 | return: block 96 | ] [ 97 | ] 98 | get-path: func [ 99 | block 100 | selector [val!] 101 | 102 | return: result [val!] 103 | ] [ 104 | switch-type selector [ 105 | integer! [ 106 | normalize block 107 | pos: block/pos + to int! selector 108 | either any [pos < 0 pos >= length-of block/values] [ 109 | make none! none 110 | ] [ 111 | block/values/(pos) 112 | ] 113 | ] 114 | any-type! [ 115 | cause-error 'script 'invalid-path selector 116 | ] 117 | ] 118 | ] 119 | set-path: func [ 120 | block 121 | selector [val!] 122 | set-to [val!] 123 | 124 | return: set-to 125 | ] [ 126 | switch-type selector [ 127 | integer! [ 128 | normalize block 129 | pos: block/pos + to int! selector 130 | either any [pos < 0 pos >= length-of block/values] [ 131 | cause-error 'script 'out-of-range selector 132 | ] [ 133 | block/values/(pos): set-to 134 | ] 135 | ] 136 | any-type! [ 137 | cause-error 'script 'invalid-path selector 138 | ] 139 | ] 140 | set-to 141 | ] 142 | ] 143 | support: [ 144 | normalize: func [ 145 | "Ensure that block/pos is not past the end of the block/values array" 146 | block [any-block!] 147 | ] [ 148 | if block/pos > length-of block/values [ 149 | block/pos: length-of block/values 150 | ] 151 | ] 152 | insert-one: func [ 153 | "Insert one value into a block" 154 | block [any-block!] 155 | value [val!] 156 | ] [ 157 | shift-array block/values block/pos 1 158 | block/values/(block/pos): value 159 | ] 160 | insert-many: func [ 161 | "Insert many values into a block" 162 | block [any-block!] 163 | values [array of val!] 164 | from [int!] 165 | len [int!] 166 | ] [ 167 | shift-array block/values block/pos len 168 | max-i: block/pos + len 169 | for [i: block/pos j: from] [i < max-i] [inc [i j]] [ 170 | block/values/(i): values/(j) 171 | ] 172 | ] 173 | mold-values: func [ 174 | "Mold an array of values" 175 | open [str!] 176 | close [str!] 177 | sep [str!] 178 | flat [bit!] 179 | nlsep [str!] 180 | indent [str!] 181 | limit [int!] 182 | values [array of val!] 183 | pos [int!] 184 | 185 | return: result [str!] 186 | ] [ 187 | result: open 188 | if pos < length-of values [ 189 | value: mold values/(pos) false flat limit indent 190 | limit: limit - length-of value 191 | result: rejoin [ 192 | result 193 | either values/(pos)/new-line? [nlsep] [""] 194 | value 195 | ] 196 | pos: pos + 1 197 | while [all [limit > 0 pos < length-of values]] [ 198 | value: mold values/(pos) false flat limit indent 199 | limit: limit - length-of value 200 | result: rejoin [ 201 | result 202 | either values/(pos)/new-line? [nlsep] [sep] 203 | value 204 | ] 205 | pos: pos + 1 206 | ] 207 | ] 208 | either limit >= length-of close [ 209 | rejoin [result close] 210 | ] [ 211 | result: rejoin [result copy-array close 0 limit] 212 | len: length-of result 213 | if len > 3 [ 214 | result/(len - 1): #"." 215 | result/(len - 2): #"." 216 | result/(len - 3): #"." 217 | ] 218 | result 219 | ] 220 | ] 221 | ] 222 | -------------------------------------------------------------------------------- /next/types/datatype.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Definition of DATATYPE! values" 3 | Author: "Gabriele Santilli" 4 | Version: ;1.0.0 5 | Type: Datatype 6 | ] 7 | 8 | ; please note that datatype! is treated specially by the compiler. 9 | 10 | name: 'datatype! 11 | based-on: 'value! 12 | properties: [ 13 | name: i32! ; symbol id of the datatype name 14 | ] 15 | actions: [ 16 | mold: func [ 17 | type 18 | only [bit!] 19 | flat [bit!] 20 | limit [val!] 21 | indent [val!] 22 | 23 | return: text [str!] 24 | ] [ 25 | limit-string symbol-to-str type/name 0 limit 26 | ] 27 | ] 28 | -------------------------------------------------------------------------------- /next/types/value.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Basic definitions for all Topaz values" 3 | Author: "Gabriele Santilli" 4 | Version: ;1.0.0 5 | Type: Datatype/Internal 6 | ] 7 | 8 | name: 'value! 9 | properties: [ 10 | new-line?: bit! 11 | ] 12 | natives: [ 13 | set-new-line: func [ 14 | "Set new line flag" 15 | value [any-type!] 16 | flag [logic!] 17 | 18 | return: flag [logic!] "Same value passed as argument" 19 | ] [ 20 | value/new-line?: to bit! flag 21 | flag 22 | ] 23 | get-new-line: func [ 24 | "Get new line flag" 25 | value [any-type!] 26 | 27 | return: flag [logic!] 28 | ] [ 29 | make logic! value/new-line? 30 | ] 31 | ] 32 | actions: [ 33 | bind: func [ 34 | value 35 | context [val!] 36 | copy [bit!] 37 | new [bit!] 38 | 39 | return: value 40 | ] [ 41 | ; BIND only does something on words, or things that may contain words (eg blocks) 42 | value 43 | ] 44 | do: func [ 45 | value 46 | block [val!] 47 | 48 | return: 49 | result [val!] 50 | block [val!] 51 | ] [ 52 | return value skip block 1 53 | ] 54 | ] 55 | support: [ 56 | limit-string: func [ 57 | string [str!] 58 | limit [val!] 59 | 60 | return: string [str!] 61 | ] [ 62 | switch-type limit [ 63 | integer! [ 64 | len: to int! limit 65 | string: copy-array string 0 len 66 | if len > 3 [ 67 | string/(len - 1): #"." 68 | string/(len - 2): #"." 69 | string/(len - 3): #"." 70 | ] 71 | ] 72 | ] 73 | string 74 | ] 75 | ] 76 | -------------------------------------------------------------------------------- /topaz/actions.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Topaz action helpers" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2011 5 | Type: Fake-Topaz 6 | ; License: { 7 | ; Permission is hereby granted, free of charge, to any person obtaining 8 | ; a copy of this software and associated documentation files 9 | ; (the "Software"), to deal in the Software without restriction, including 10 | ; without limitation the rights to use, copy, modify, merge, publish, 11 | ; distribute, sublicense, and/or sell copies of the Software, and to 12 | ; permit persons to whom the Software is furnished to do so, subject 13 | ; to the following conditions: 14 | 15 | ; The above copyright notice and this permission notice shall be included 16 | ; in all copies or substantial portions of the Software. 17 | 18 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 19 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 21 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 22 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 23 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 24 | ; OTHER DEALINGS IN THE SOFTWARE. 25 | ; } 26 | ] 27 | 28 | ; ===== ACTION HELPERS ======================================================== 29 | 30 | make: function [ 31 | "Make a Topaz type according to spec" 32 | type [datatype!] 33 | spec 34 | ] [] [ 35 | apply type/make [spec] 36 | ] 37 | 38 | insert: function [ 39 | "Insert a value at the current position of the series" 40 | series [series!] 41 | value 42 | options: 43 | only: no [logic!] "Insert series as a single value" 44 | new-line: no [logic!] "Temporary - add new line before value on MOLD" 45 | ] [] [ 46 | apply series/type/insert [series value only new-line] 47 | ] 48 | 49 | head: function [ 50 | "Return the series at the head position" 51 | series [series!] 52 | ] [] [ 53 | apply series/type/head [series] 54 | ] 55 | 56 | tail: function [ 57 | "Return the series at the tail position" 58 | series [series!] 59 | ] [] [ 60 | apply series/type/tail [series] 61 | ] 62 | 63 | pick: function [ 64 | "Pick value in a series" 65 | series [series!] 66 | index [number!] 67 | ] [] [ 68 | apply series/type/pick [series index] 69 | ] 70 | 71 | length-of: function [ 72 | "Return the length of a series" 73 | series [series!] 74 | ] [] [ 75 | apply series/type/length-of [series] 76 | ] 77 | 78 | empty?: function [ 79 | "True if the series is empty" 80 | series [series!] 81 | ] [] [ 82 | 0 = length-of series 83 | ] 84 | 85 | skip: function [ 86 | "Return the series at a new position" 87 | series [series!] 88 | amount [number!] "Skip the specified number of values" 89 | ] [] [ 90 | apply series/type/skip [series amount] 91 | ] 92 | 93 | mold: function [ 94 | "Return a LOAD-able text representation of a value" 95 | value 96 | options: 97 | only: no [logic!] "Don't generate outer [ ] for block! values" 98 | flat: no [logic!] "Produce a single text line" 99 | limit [number! none!] "Don't return a string longer than LIMIT characters" 100 | indent: "" [string!] "Add this string after each new line (ignored if flat)" 101 | ] [] [ 102 | apply value/type/mold [value only flat limit indent] 103 | ] 104 | 105 | first: function [series] [] [ 106 | pick series 0 107 | ] 108 | second: function [series] [] [ 109 | pick series 1 110 | ] 111 | next: function [series] [] [ 112 | skip series 1 113 | ] 114 | 115 | do-step: function [ 116 | "Evaluate one value" 117 | value 118 | block [block! paren!] 119 | ] [result arg2 op err] [ 120 | try [ 121 | set [result block] apply value/type/do [value block] 122 | ] 'e [ 123 | e: handle-js-error e 124 | if e/type/name = "error!" [ 125 | insert/only tail e/stack block 126 | ] 127 | throw e 128 | ] 129 | while [op: operator? block] [ 130 | block: skip block 1 131 | if empty? block [ 132 | err: make error! make-struct [ 133 | category: "Script" 134 | id: "missing-argument" 135 | message: "Operator missing its second argument" 136 | ] 137 | insert/only tail err/stack skip block -2 138 | throw err 139 | ] 140 | arg2: first block 141 | set [arg2 block] apply arg2/type/do [arg2 block] 142 | result: do-op op result arg2 143 | ] 144 | reduce [result block] 145 | ] 146 | 147 | get-path: function [ 148 | "Apply path selector to a value" 149 | value 150 | selector 151 | ] [] [ 152 | switch selector/type/name [ 153 | "paren!" [ 154 | selector: do selector 155 | ] 156 | "get-word!" [ 157 | selector: get selector 158 | ] 159 | ] 160 | apply value/type/get-path [value selector] 161 | ] 162 | 163 | set-path: function [ 164 | "Set an element of a value according to path selector" 165 | value 166 | selector 167 | set-to 168 | ] [] [ 169 | switch selector/type/name [ 170 | "paren!" [ 171 | selector: do selector 172 | ] 173 | "get-word!" [ 174 | selector: get selector 175 | ] 176 | ] 177 | apply value/type/set-path [value selector set-to] 178 | ] 179 | 180 | bind: function [ 181 | "Bind words to a specified context" 182 | words 183 | context [context!] 184 | options: 185 | copy: no [logic!] "Bind a (deep) copy of WORDS" 186 | new: no [logic!] "Add all words to CONTEXT" 187 | ] [] [ 188 | apply words/type/bind [words context :copy new] 189 | ] 190 | 191 | equal?: function [ 192 | "Return TRUE if the two values are equal" 193 | val1 194 | val2 195 | ] [obj] [ 196 | either obj: val1/type/(val2/type/name) [ 197 | apply obj/equal? [val1 val2] 198 | ] [ 199 | apply val1/type/equal? [val1 val2] 200 | ] 201 | ] 202 | 203 | probe: function [ 204 | "Print a text representation of a value; return the value" 205 | value 206 | options: 207 | limit [number! none!] "Limit the length of the printed text" 208 | indent: "" [string!] "Add this string after each new line" 209 | ] [] [ 210 | print mold/options [ 211 | value: value 212 | limit: limit 213 | indent: indent 214 | ] 215 | ] 216 | -------------------------------------------------------------------------------- /topaz/compile-topaz.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Compile Topaz to topaz/topaz.js" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2011 5 | ; License: { 6 | ; Permission is hereby granted, free of charge, to any person obtaining 7 | ; a copy of this software and associated documentation files 8 | ; (the "Software"), to deal in the Software without restriction, including 9 | ; without limitation the rights to use, copy, modify, merge, publish, 10 | ; distribute, sublicense, and/or sell copies of the Software, and to 11 | ; permit persons to whom the Software is furnished to do so, subject 12 | ; to the following conditions: 13 | 14 | ; The above copyright notice and this permission notice shall be included 15 | ; in all copies or substantial portions of the Software. 16 | 17 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 18 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 20 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 21 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 22 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 23 | ; OTHER DEALINGS IN THE SOFTWARE. 24 | ; } 25 | ] 26 | 27 | interpreter: load %topaz/support.topaz 28 | 29 | app: func [code] [ 30 | append interpreter code 31 | ] 32 | 33 | app-file: func [file] [app load file] 34 | 35 | app-file %topaz/actions.topaz 36 | 37 | ; MAKE-TYPE macro 38 | make-internal-type: func [name actions] [ 39 | struct: compose [ 40 | type: datatype! 41 | name: (make string! name/value) 42 | ] 43 | ; actions is an expression! here, hopefully ast-value containing a block! 44 | append struct actions/value 45 | make expression! compose/only [ 46 | (make set-word! name/value) make-struct (struct) 47 | ] 48 | ] 49 | make-type: func [name actions] [ 50 | make expression! compose/deep [ 51 | make-internal-type name actions 52 | apply datatypes/push [(name/value)] 53 | ] 54 | ] 55 | macro: func [name spec body] [ 56 | set name/value func spec/value body/value 57 | make expression! [] 58 | ] 59 | 60 | types-dir: %topaz/types/ 61 | app-type: func [file] [app-file make file! rejoin [types-dir file]] 62 | 63 | ; until dependency resolution is added... 64 | foreach 'type [ 65 | %datatype.topaz 66 | %block.topaz 67 | %paren.topaz 68 | %path.topaz 69 | %lit-path.topaz 70 | %set-path.topaz 71 | %word.topaz 72 | %get-word.topaz 73 | %lit-word.topaz 74 | %set-word.topaz 75 | %context.topaz 76 | %function.topaz 77 | %native.topaz 78 | %action.topaz 79 | %return.topaz 80 | %op.topaz 81 | %string.topaz 82 | %char.topaz 83 | %file.topaz 84 | %none.topaz 85 | %logic.topaz 86 | %number.topaz 87 | %expression.topaz 88 | %object.topaz 89 | %throw.topaz 90 | %return-value.topaz 91 | %error.topaz 92 | %typeset.topaz 93 | ] [app-type type] 94 | 95 | foreach 'file [ 96 | %topaz/typesets.topaz 97 | %topaz/load.topaz 98 | %topaz/natives.topaz 99 | %topaz/compiler.topaz 100 | ] [app-file file] 101 | 102 | app compose/deep [ 103 | sys: apply require ["util"] 104 | fs: apply require ["fs"] 105 | try [ 106 | do load/all make string! (mold/only load %topaz/init.topaz) 107 | ] 'e [ 108 | print "FATAL: error during initialization" 109 | e: handle-js-error e 110 | if e/type/name <> "error!" [ 111 | e: make error! make-struct [ 112 | category: "Internal" 113 | id: "unhandled-throw" 114 | message: "Unhandled throw during initialization" 115 | args: e/type 116 | ] 117 | ] 118 | print form-error e 119 | apply process/exit [1] 120 | ] 121 | ] 122 | 123 | app [ 124 | handle-top-level-error: function [e] [] [ 125 | e: handle-js-error e 126 | if e/type/name <> "error!" [ 127 | e: make error! make-struct [ 128 | category: "Script" 129 | id: "unhandled-throw" 130 | message: "Unhandled exception (THROW without CATCH)" 131 | args: e/type 132 | ] 133 | ] 134 | print form-error e 135 | ] 136 | either 2 < length-of-array process/argv [ 137 | try [ 138 | ; this is done in order to use the mezz version of DO 139 | ; which handles headers 140 | do append topaz-value [do] make file! process/argv/2 141 | ] 'e [ 142 | handle-top-level-error e 143 | ] 144 | ] [ 145 | print "Topaz Interpreter - (C) 2011 Gabriele Santilli - MIT License" 146 | stdin: apply process/open-stdin [] 147 | apply stdin/set-encoding ["utf8"] 148 | apply stdin/add-listener [ 149 | "data" 150 | function [chunk] [res] [ 151 | try [ 152 | chunk: do load/all make string! chunk 153 | prin "== " print mold/options [value: chunk indent: "== " limit: 100] 154 | prin ">> " 155 | ] 'e [ 156 | handle-top-level-error e 157 | prin ">> " 158 | ] 159 | ] 160 | ] 161 | prin ">> " 162 | ] 163 | ] 164 | 165 | parse-function-spec: func [spec] [ 166 | ; does not support return: yet, nor default values 167 | parse spec [ 168 | collect any [ 169 | string! 170 | | 171 | block! 172 | | 173 | 'options 174 | | 175 | name: set-word! skip keep (make word! name) 176 | | 177 | keep word! 178 | | 179 | spec: here skip (cause make error! [ 180 | category: 'Compilation 181 | id: 'invalid-spec 182 | message: "PARSE-FUNCTION-SPEC: Don't know how to handle this, yet" 183 | stack: spec 184 | ]) 185 | ] 186 | ] 187 | ] 188 | funcall-macro: func [name spec] [ 189 | make function! reduce [ 190 | spec 191 | compose/only/deep [ 192 | make expression! [ 193 | apply (make get-word! name) (parse-function-spec spec) 194 | ] 195 | ] 196 | ] 197 | ] 198 | 199 | ; define function call macros, make all set-words local, mask some interpreter functions 200 | locals: parse interpreter [ 201 | collect any [ 202 | name: set-word! 'function 203 | keep (name) keep ('funcall-macro) keep (make lit-word! name) 204 | keep/only block! block! block! 205 | | 206 | 'macro name: lit-word! block! block! keep (make set-word! name) keep (none) 207 | | 208 | skip 209 | ] 210 | ] 211 | locals: context append locals [context: func: object: none] 212 | bind interpreter locals 213 | bind interpreter compiler-keywords 214 | 215 | write %topaz/topaz.js compile interpreter 216 | -------------------------------------------------------------------------------- /topaz/concepts.rmd: -------------------------------------------------------------------------------- 1 | Topaz concepts 2 | 3 | Author: "Gabriele Santilli" 4 | Purpose: {Some of the ideas I plan to implement in Topaz} 5 | 6 | ===Introduction 7 | 8 | Given that Topaz is proceeding slowly lately, and that there are other 9 | interesting languages coming out such as Red which are still young enough to 10 | allow changes, I thought about publishing this document with some of the ideas 11 | I plan to have in Topaz, so that maybe they can be useful for the other 12 | languages as well. 13 | 14 | ===Type classes 15 | 16 | REBOL 3 introduced type sets as a way to handle pseudo-types like |series!|, 17 | function argument specs, etc. Topaz also supports type sets for the same 18 | reasons, however, they have the disadvantage of being "static", that is, they 19 | don't make sense if the language allows adding new data types at run time. 20 | 21 | For example, if you add a new type that behaves like a series, you'll want to 22 | add it to the |series!| typeset; this implies that you know that a |series!| 23 | typeset exists, and that it is mutable and never copied. In the end, this 24 | approach is not going to work, and at best would require type implementers to 25 | do a lot of work. 26 | 27 | For this reason, Topaz introduces the concept of type classes. (You may be 28 | familiar with the idea if you have used languages like Haskell etc.) You can 29 | think of a type class as a "dynamic type set". It behaves like a type set, 30 | except that the member types are determined dynamically, by their properties, 31 | rather than listed upon creation of the type set. 32 | 33 | For example, a |list!| type class may represent all types that support the 34 | |first| and |next| actions. (Actually, |first| is going to be based on |pick| 35 | in Topaz, but the idea is the same.) If you create a new type that can handle 36 | those two actions, then it is made automatically part of the |list!| type 37 | class, and will be usable by any function that expects a |list!|. 38 | 39 | Most "pseudo types", like |series!| etc., in Topaz will be type classes. They 40 | are defined from a list of actions (and possibly "reflectors") that the type 41 | has to support in order to be part of the class. 42 | 43 | Note that this implies that the behavior of each action needs to be more 44 | precisely defined to ensure the consistency of the types that are members of 45 | the same type class. 46 | 47 | ===Object classes 48 | 49 | I'm still on the fence on this (because custom types may be a better choice 50 | most of the time), but, they seem a useful enough concept. They work in the 51 | same way as type classes: class membership is not defined statically like in 52 | class-based OOP languages, rather, an object class defines the properties (eg. 53 | fields and their type) that an object must satisfy in order to be part of the 54 | class. 55 | 56 | For example, you could say that an |object!| value is part of the |person| 57 | object class if it has two fields, |first-name| and |last-name|, and they are 58 | both set to |string!| values. 59 | 60 | ===Function classes 61 | 62 | In the same spirit as type classes and object classes, function classes define 63 | classes of |function!| values. All functions with the same argument spec (maybe 64 | with some margin for variability, eg. extra options) are part of the same 65 | class. 66 | 67 | This is useful when passing arguments that are |function!| values, as the 68 | receiver is usually expecting the argument to behave in a specific way (eg. 69 | take two arguments of a specific type). 70 | 71 | ===Custom types 72 | 73 | It's easy to add new types to Topaz and rebuild the interpreter, but it's still 74 | useful to be able to add new types dynamically at run time as well. The simplest 75 | way to accomplish this is to just "wrap" |object!| values so that they appear 76 | as values of the new custom type. So, under the hood, you're just dealing with 77 | objects, but you can define your own actions for them and have them behave in 78 | any way you wish. 79 | 80 | A value of a custom type thus is just a wrapper around an actual |object!| 81 | value which is what your action code will see internally. 82 | 83 | ===To promise, or not to promise 84 | 85 | Like REBOL 3, I/O in Topaz is going to be completely asynchronous. This does 86 | however pose a problem: writing code for async I/O is more complicated than it 87 | needs to be. Since our goal is that simple things should be simple to do, and 88 | complex things possible, complicating the simple cases is not a good idea. 89 | 90 | There is a way though to have the benefits of async I/O while keeping code 91 | readable and simple (at least in the simple cases): the concept of promised 92 | values. 93 | 94 | The idea is simple: imagine you have something like: 95 | 96 | #lit page: read http://www.colellachiara.com/ 97 | 98 | With I/O being async, you're usually forced to write it like: 99 | 100 | read http://www.colellachiara.com/ func [page] [...] 101 | 102 | which gets really ugly really fast. Instead, what can be done is having |read| 103 | return a "promise" for the page instead of the page itself, so you still write: 104 | 105 | #lit page: read http://www.colellachiara.com/ 106 | 107 | where |page| is not a |string!| anymore, but a promise for a string to be 108 | delivered later. 109 | 110 | A simple (but, insufficient - see below) way to implement this would be to 111 | offer a |promise!| type, and to have a wrapper around functions so that 112 | whenever any one of the arguments is a |promise!|, the function will wait for 113 | it to be resolved (ie. for the actual promised value to be delivered) before 114 | calling the actual function code; the function thus returns immediately a 115 | promise for its result value. 116 | 117 | That would make it possible to write something like: 118 | 119 | #lit x: read http://www.colellachiara.com/ 120 | y: read http://www.roccacasale.it/ 121 | z: join x y 122 | print z 123 | 124 | It looks like synchronous code, but everything actually happens asynchronously. 125 | |x| and |y| are promises that are fulfilled in parallel; |z| is a promise for 126 | the result of |join|. Thus, |join| waits until both |x| and |y| are resolved, 127 | then resolves |z| with the result of joining |x| and |y|. |print| waits for |z| 128 | to be resolved, then prints it. 129 | 130 | It's nice and works very well, and can be implemented at the mezz level (even 131 | in REBOL 3 for eg.), except for one thing: 132 | 133 | #lit x: none 134 | page: read http://www.colellachiara.com/ 135 | if find page "Topaz" [ 136 | x: "Found Topaz" 137 | ] 138 | print x 139 | 140 | Even if |find| and |if| have been adapted to work with promised values, |print| 141 | only sees |none| as its argument here, because the body block of |if| is only 142 | executed when the promise for |page| is resolved. 143 | 144 | To solve this problem, the interpreter itself needs to handle cases like this, 145 | and assume that whatever follows the |if| can only be evaluated once the 146 | promise resulting from the |if| is resolved, etc. At that point, though, there 147 | is no need anymore to expose |promise!| values to the user: the interpreter can 148 | handle all this internally, and "pretend" it's evaluating things serially while 149 | actually doing everything in parallel and only serializing based on 150 | dependencies. (A compiler can do more than this, and detect whether the |print| 151 | after the |if| actually needs to wait for the |if| to complete or not.) 152 | 153 | There are more issues (eg. correctly serializing writes), but overall the idea 154 | is to have the interpreter doing things in parallel whenever possible 155 | automatically, while you write nice simple code. 156 | 157 | ===|port!| types 158 | 159 | In Topaz, |port!| is a type class, and every different kind of port is its own 160 | type. The reason is that in REBOL ports are the closest thing to custom types, 161 | except that they are specific to one class of types; but, since we have real 162 | custom types in Topaz, there is no need for this special case. 163 | -------------------------------------------------------------------------------- /topaz/load.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Topaz parser and LOAD native" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2011 5 | Type: Fake-Topaz 6 | ; License: { 7 | ; Permission is hereby granted, free of charge, to any person obtaining 8 | ; a copy of this software and associated documentation files 9 | ; (the "Software"), to deal in the Software without restriction, including 10 | ; without limitation the rights to use, copy, modify, merge, publish, 11 | ; distribute, sublicense, and/or sell copies of the Software, and to 12 | ; permit persons to whom the Software is furnished to do so, subject 13 | ; to the following conditions: 14 | 15 | ; The above copyright notice and this permission notice shall be included 16 | ; in all copies or substantial portions of the Software. 17 | 18 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 19 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 21 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 22 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 23 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 24 | ; OTHER DEALINGS IN THE SOFTWARE. 25 | ; } 26 | ] 27 | 28 | ; ===== TYPES: PARSERS ======================================================== 29 | 30 | skip-spaces: function [text] [t newline?] [ 31 | t: exec-re to-js-string text regexp "^^(\s|;.*\n)+" "" 32 | newline?: false 33 | if t [ 34 | t: pick-array t 0 35 | newline?: test-re t regexp "\n" "" 36 | text: skip text length-of-array t 37 | ] 38 | reduce [text newline?] 39 | ] 40 | 41 | parse-word-chars: function [text] [t] [ 42 | if t: exec-re to-js-string text regexp "^^[!&*+\-.<=>?A-Z^^_`a-z|~-ÿ]['!&*+\-.0-9<=>?A-Z^^_`a-z|~-ÿ]*" "" [ 43 | pick-array t 0 44 | ] 45 | ] 46 | 47 | parse-path-element: function [text] [] [ 48 | any [ 49 | parse-number text 50 | parse-get-word text 51 | parse-word text 52 | parse-string text 53 | parse-file text 54 | parse-block text 55 | parse-paren text 56 | parse-char text 57 | ] 58 | ] 59 | 60 | parse-value: function [text] [] [ 61 | any [ 62 | parse-number text 63 | parse-set-word text 64 | parse-set-path text 65 | parse-path text 66 | parse-lit-path text 67 | parse-word text 68 | parse-lit-word text 69 | parse-get-word text 70 | parse-string text 71 | parse-file text 72 | parse-block text 73 | parse-paren text 74 | parse-char text 75 | ] 76 | ] 77 | 78 | parse-values: function [values text] [value newline?] [ 79 | set [text newline?] skip-spaces text 80 | while [all [not empty? text #"]" <> first text #")" <> first text]] [ 81 | set [value text] parse-value text 82 | either value [ 83 | values: insert/options [ 84 | series: values 85 | value: value 86 | only 87 | new-line: newline? 88 | ] 89 | set [text newline?] skip-spaces text 90 | ] [ 91 | error make-struct [ 92 | category: "Syntax" 93 | id: "load-error" 94 | message: "Parse error" 95 | stack: text 96 | ] 97 | ] 98 | ] 99 | set-new-line values newline? 100 | reduce [head values text] 101 | ] 102 | 103 | ; ===== NATIVES =============================================================== 104 | 105 | system-words: make context! none 106 | 107 | load-raw: function [type text] [values] [ 108 | set [values text] parse-values make type none text 109 | if not empty? text [ 110 | error make-struct [ 111 | category: "Syntax" 112 | id: "load-error" 113 | message: "Parse error" 114 | stack: text 115 | ] 116 | ] 117 | values 118 | ] 119 | 120 | load: function [ 121 | "Load the string into a Topaz value" 122 | text [string!] "Text representation of a Topaz value" 123 | options: 124 | all: no [logic!] "Always return a BLOCK! value" 125 | ] [values] [ 126 | values: load-raw block! text 127 | bind/new values system-words 128 | ; the compiler does not bind (yet), so ALL vs. :ALL works 129 | either all [not :all 1 = length-of values] [ 130 | first values 131 | ] [ 132 | values 133 | ] 134 | ] 135 | -------------------------------------------------------------------------------- /topaz/support.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Topaz support functions" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2011 5 | Type: Fake-Topaz 6 | ; License: { 7 | ; Permission is hereby granted, free of charge, to any person obtaining 8 | ; a copy of this software and associated documentation files 9 | ; (the "Software"), to deal in the Software without restriction, including 10 | ; without limitation the rights to use, copy, modify, merge, publish, 11 | ; distribute, sublicense, and/or sell copies of the Software, and to 12 | ; permit persons to whom the Software is furnished to do so, subject 13 | ; to the following conditions: 14 | 15 | ; The above copyright notice and this permission notice shall be included 16 | ; in all copies or substantial portions of the Software. 17 | 18 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 19 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 20 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 21 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 22 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 23 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 24 | ; OTHER DEALINGS IN THE SOFTWARE. 25 | ; } 26 | ] 27 | 28 | ; ===== SUPPORT FUNCTIONS ===================================================== 29 | 30 | prin: function [text] [] [ 31 | apply sys/print [text] 32 | text 33 | ] 34 | print: function [text] [] [ 35 | apply sys/print [text + "^/"] 36 | text 37 | ] 38 | 39 | js-probe: function [value] [] [ 40 | print apply sys/inspect [value] 41 | value 42 | ] 43 | 44 | length-of-array: function [arr] [] [ 45 | arr/length 46 | ] 47 | 48 | insert-array: function [arr pos value] [] [ 49 | apply arr/splice [pos 0 value] 50 | ] 51 | 52 | clear-array: function [arr pos] [] [ 53 | apply arr/splice [pos] 54 | ] 55 | 56 | slice-array: function [arr begin end] [] [ 57 | apply arr/slice [begin end] 58 | ] 59 | 60 | copy-array: function [arr begin] [] [ 61 | apply arr/slice [begin] 62 | ] 63 | 64 | concat: function [arr1 arr2] [] [ 65 | apply arr1/concat [arr2] 66 | ] 67 | 68 | insert-array2: function [arr1 pos arr2] [] [ 69 | apply arr1/splice/apply [arr1 concat reduce [pos 0] arr2] 70 | ] 71 | 72 | concat3: function [arr1 arr2 arr3] [] [ 73 | apply arr1/concat [arr2 arr3] 74 | ] 75 | 76 | name-to-js: function [name] [] [ 77 | switch-default name [ 78 | "arguments" ["_arguments"] 79 | "do" ["_do"] 80 | "json" ["JSON"] 81 | "case" ["_case"] 82 | "try" ["_try"] 83 | "throw" ["_throw"] 84 | "function" ["_function"] 85 | "if" ["_if"] 86 | "while" ["_while"] 87 | "switch" ["_switch"] 88 | "true" ["_true"] 89 | "false" ["_false"] 90 | "catch" ["_catch"] 91 | "new" ["_new"] 92 | ] [ 93 | name: apply name/replace [ 94 | regexp "-(.)" "g" 95 | function [match chr] [] [ 96 | apply chr/to-upper-case [] 97 | ] 98 | ] 99 | name: apply name/replace [ 100 | regexp "^^(.)(.*)\?$" "" 101 | function [match chr rest] [] [ 102 | rejoin ["is" apply chr/to-upper-case [] rest] 103 | ] 104 | ] 105 | apply name/replace ["!" "_type"] 106 | ] 107 | ] 108 | 109 | collect-set-words: function [ 110 | "Collect all SET-WORD!s in the block" 111 | setwords [any-block!] "SET-WORD!s are appended here" 112 | block [any-block!] 113 | options: 114 | deep: no [logic!] "Recurse into sub-blocks" 115 | ] [value] [ 116 | while [not empty? block] [ 117 | value: first block 118 | switch value/type/name [ 119 | "set-word!" [ 120 | append setwords value 121 | ] 122 | "block!" [if deep [collect-set-words/deep setwords value]] 123 | "paren!" [if deep [collect-set-words/deep setwords value]] 124 | ] 125 | block: skip block 1 126 | ] 127 | setwords 128 | ] 129 | 130 | clone-array: function [arr] [] [ 131 | apply arr/concat [] 132 | ] 133 | 134 | pop-array: function [arr] [] [ 135 | apply arr/pop [] 136 | ] 137 | 138 | append-array: function [arr value] [] [ 139 | apply arr/push [value] 140 | ] 141 | 142 | exec-re: function [str re] [] [ 143 | apply re/exec [str] 144 | ] 145 | 146 | test-re: function [str re] [] [ 147 | apply re/test [str] 148 | ] 149 | 150 | empty-array?: function [array] [] [ 151 | 0 = length-of-array array 152 | ] 153 | 154 | true?: function [value] [] [ 155 | switch-default value/type/name [ 156 | "none!" [false] 157 | "logic!" [value/value] 158 | ] [ 159 | true 160 | ] 161 | ] 162 | 163 | default-equal?: function [value1 value2] [] [false] 164 | 165 | default-bind: function [ 166 | "Bind words to a specified context" 167 | words 168 | context [context!] 169 | options: 170 | copy: no [logic!] "Bind a (deep) copy of WORDS" 171 | new: no [logic!] "Add all words to CONTEXT" 172 | ] [] [words] 173 | 174 | _foreach: function [arr fnc] [] [ 175 | apply arr/for-each [fnc] 176 | ] 177 | macro 'foreach [word arr body] [ 178 | word: word/value 179 | if not system/words/block? word [word: system/words/reduce [word]] 180 | system/words/make system/words/expression! compose/only [ 181 | _foreach arr function (word) [] body 182 | ] 183 | ] 184 | ; _foreach-blk defined in types/block.topaz 185 | macro 'foreach-blk [word block body] [ 186 | word: word/value 187 | if not system/words/block? word [word: system/words/reduce [word]] 188 | system/words/make system/words/expression! compose/only [ 189 | _foreach-blk block function (word) [] body 190 | ] 191 | ] 192 | 193 | handle-js-error: function [value] [] [ 194 | either js-error? value [ 195 | make error! make-struct [ 196 | category: "Internal" 197 | id: "js-error" 198 | message: "Javascript error" 199 | args: make string! value/message 200 | stack: if value/stack [make string! value/stack] 201 | ] 202 | ] [ 203 | value 204 | ] 205 | ] 206 | 207 | ; cheap way to clone objects 208 | clone-object: function [obj] [] [ 209 | make-struct [__proto__: obj] 210 | ] 211 | 212 | macro 'topaz-value [value] [ 213 | value: system/words/mold value/value 214 | system/words/make system/words/expression! compose [ 215 | load make string! (value) 216 | ] 217 | ] 218 | 219 | limit-string: function [string limit] [] [ 220 | case [ 221 | any [ 222 | limit = none 223 | limit >= length-of-array string 224 | ] [ 225 | string 226 | ] 227 | limit > 3 [ 228 | rejoin [slice-array string 0 limit - 3 "..."] 229 | ] 230 | 'else [ 231 | slice-array "..." 0 limit 232 | ] 233 | ] 234 | ] 235 | 236 | within-limit?: function [string limit] [] [ 237 | any [ 238 | limit = none 239 | limit > length-of-array string 240 | ] 241 | ] 242 | 243 | subtract-limit: function [string limit] [] [ 244 | either limit = none [none] [ 245 | limit - length-of-array string 246 | ] 247 | ] 248 | -------------------------------------------------------------------------------- /topaz/tests/blocks-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %blocks.topaz" 3 | Type: 'Test-Results 4 | Passed: 19 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: [] 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: [] 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: 2 23 | ] object none [ 24 | passed?: true 25 | unhandled-throw?: false 26 | caused-error?: false 27 | result: 3 28 | ] object none [ 29 | passed?: true 30 | unhandled-throw?: false 31 | caused-error?: false 32 | result: true 33 | ] object none [ 34 | passed?: true 35 | unhandled-throw?: false 36 | caused-error?: false 37 | result: [2 3] 38 | ] object none [ 39 | passed?: true 40 | unhandled-throw?: false 41 | caused-error?: false 42 | result: [3] 43 | ] object none [ 44 | passed?: true 45 | unhandled-throw?: false 46 | caused-error?: false 47 | result: [1 2 3] 48 | ] object none [ 49 | passed?: true 50 | unhandled-throw?: false 51 | caused-error?: false 52 | result: "[1 2 3]" 53 | ] object none [ 54 | passed?: true 55 | unhandled-throw?: false 56 | caused-error?: false 57 | result: [] 58 | ] object none [ 59 | passed?: true 60 | unhandled-throw?: false 61 | caused-error?: false 62 | result: [] 63 | ] object none [ 64 | passed?: true 65 | unhandled-throw?: false 66 | caused-error?: false 67 | result: 1 68 | ] object none [ 69 | passed?: true 70 | unhandled-throw?: false 71 | caused-error?: false 72 | result: "()" 73 | ] object none [ 74 | passed?: true 75 | unhandled-throw?: false 76 | caused-error?: false 77 | result: [1 2 3 4] 78 | ] object none [ 79 | passed?: true 80 | unhandled-throw?: false 81 | caused-error?: false 82 | result: true 83 | ] object none [ 84 | passed?: true 85 | unhandled-throw?: false 86 | caused-error?: false 87 | result: false 88 | ] object none [ 89 | passed?: true 90 | unhandled-throw?: false 91 | caused-error?: false 92 | result: false 93 | ] object none [ 94 | passed?: true 95 | unhandled-throw?: false 96 | caused-error?: false 97 | result: true 98 | ] object none [ 99 | passed?: true 100 | unhandled-throw?: false 101 | caused-error?: false 102 | result: "[none one none three]" 103 | ] -------------------------------------------------------------------------------- /topaz/tests/blocks.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for BLOCK! and PAREN! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [insert [] 1] 8 | [head []] 9 | [pick [1 2 3] 1] 10 | [length-of [1 2 3]] 11 | [empty? []] 12 | [skip [1 2 3] 1] 13 | [skip [1 2 3] 2] 14 | [head skip [1 2 3] 2] 15 | [mold [1 2 3]] 16 | [tail [1 2 3]] 17 | [make block! 0] 18 | [first [1 2 3]] 19 | [mold make paren! 0] 20 | [append [1 2 3] 4] 21 | [[1 2 3] = [1 2 3]] 22 | [[1 2 3 4] = [1 2 3]] 23 | [[1 2 3 4] = [1 2 3 5]] 24 | [[a b "c d e"] = [a b "c d e"]] 25 | [ 26 | b: make block! none 27 | b/1: 'one 28 | b/3: 'three 29 | mold b 30 | ] 31 | -------------------------------------------------------------------------------- /topaz/tests/compiler-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %compiler.topaz" 3 | Type: 'Test-Results 4 | Passed: 2 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: "a=1+1;" 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: "print=function(text){sys.print(text);return text;};print(^"one^");print(^"two^");" 18 | ] -------------------------------------------------------------------------------- /topaz/tests/compiler.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for the 'Fake Topaz' compiler" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [compile [a: 1 + 1]] 8 | [ 9 | ; makes 'print local 10 | compile-test: func [] [ 11 | print: func [text] [make expression! [apply :print [text]]] 12 | compile [ 13 | print: function [text] [] [ 14 | apply sys/print [text] 15 | text 16 | ] 17 | print "one" 18 | print "two" 19 | ] 20 | ] 21 | compile-test 22 | ] 23 | -------------------------------------------------------------------------------- /topaz/tests/contexts-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %contexts.topaz" 3 | Type: 'Test-Results 4 | Passed: 3 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: "context [^/ a: 1^/ b: 2^/]" 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: "[3 7 context [^/ a: 3^/ b: 4^/ ]]" 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: "print" 23 | ] -------------------------------------------------------------------------------- /topaz/tests/contexts.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for CONTEXT! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [mold context [a: 1 b: 2]] 8 | [ 9 | a: 1 b: 2 10 | code: [a + b] 11 | res1: do code 12 | ctx: context [a: 3 b: 4] 13 | bind code ctx 14 | res2: do code 15 | mold reduce [ 16 | res1 17 | res2 18 | context-of first code 19 | ] 20 | ] 21 | [mold 'print in system/words] 22 | -------------------------------------------------------------------------------- /topaz/tests/errors-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %errors.topaz" 3 | Type: 'Test-Results 4 | Passed: 2 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: make error! [ 13 | category: 'Script 14 | id: 'invalid-argument 15 | message: "Invalid argument for MAKE ERROR!" 16 | stack: [] 17 | ] 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: make error! [ 23 | category: 'Script 24 | id: 'invalid-argument 25 | message: "Invalid argument test error" 26 | args: 1 27 | stack: [[1] [2] [3]] 28 | ] 29 | ] -------------------------------------------------------------------------------- /topaz/tests/errors.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for ERROR! values and error handling" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [make error! none] 8 | [ 9 | make error! [ 10 | category: 'Script 11 | id: 'invalid-argument 12 | message: "Invalid argument test error" 13 | args: 1 14 | stack: [[1] [2] [3]] 15 | ] 16 | ] 17 | -------------------------------------------------------------------------------- /topaz/tests/functions.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for FUNCTION!, NATIVE!, ACTION! and OP! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [mold make function! [[a b] [a]]] 8 | [mold make native! [[series value] insert]] 9 | [mold f: func [a b c] [reduce [a b c]]] 10 | [f 1 2 3] 11 | [f 'a 'b 'c] 12 | [f f 1 2 3 f 4 5 6 f 7 8 9] 13 | [1 + 1] 14 | [1 - 1] 15 | [g: func [a b] [mold a + b] mold ++: make op! :g] 16 | [1 ++ 1] 17 | [1 > 2] 18 | [1 < 2] 19 | [2 + 2 <= 4] 20 | ; bug with recursive functions 21 | [ 22 | f: func [a] [if a > 1 [f a - 1]] 23 | f 2 24 | ] 25 | [ 26 | mold f: func [ 27 | "This is a test function" 28 | a [number!] "A number" 29 | b [any-word!] "A word" 30 | ] [ 31 | rejoin ["A: " mold a " B: " mold b] 32 | ] 33 | ] 34 | [f 1 'word] 35 | [f 'word 1] 36 | [f 1 2] 37 | [ 38 | mold f: func [ 39 | "This is a test function" 40 | a [number!] "A number" 41 | b "Anything" 42 | options: 43 | c [word!] "A word" 44 | d: 1 "Anything, default 1" 45 | e: 'bla [any-word!] "Only words" 46 | ] [ 47 | rejoin [ 48 | "A: " mold a "^/" 49 | "B: " mold b "^/" 50 | "C: " mold c "^/" 51 | "D: " mold d "^/" 52 | "E: " mold e 53 | ] 54 | ] 55 | ] 56 | [f 1 'word] 57 | [f 'word 1] 58 | [f 1 2] 59 | [f/c 1 2] 60 | [f/d 1 2] 61 | [ 62 | f/options [ 63 | a: 1 64 | b: "something" 65 | c: 'bla 66 | ] 67 | ] 68 | [ 69 | f/options [ 70 | a: 1 71 | b: "something" 72 | c: 1 73 | ] 74 | ] 75 | [ 76 | f/options [ 77 | a: 1 78 | b: "something" 79 | d: "something else" 80 | e: first [set-word:] 81 | ] 82 | ] 83 | [ 84 | f/options [ 85 | d: "something else" 86 | e: first [set-word:] 87 | ] 88 | ] 89 | [ 90 | f/options [ 91 | b: "something" 92 | d: "something else" 93 | e: first [set-word:] 94 | a: 1 95 | ] 96 | ] 97 | [ 98 | mold f: func [ 99 | "This is a test function" 100 | a [number!] "A number" 101 | b "Anything" 102 | c [word!] "A word" 103 | d "Anything" 104 | e [any-word!] "Only words" 105 | ] [ 106 | rejoin [ 107 | "A: " mold a "^/" 108 | "B: " mold b "^/" 109 | "C: " mold c "^/" 110 | "D: " mold d "^/" 111 | "E: " mold e 112 | ] 113 | ] 114 | ] 115 | [f 1 2 3 4 5] 116 | [ 117 | f [ 118 | b: 1 119 | a: 2 120 | c: 'bla 121 | d: 3 122 | e: first ['bla] 123 | ] 124 | ] 125 | [ 126 | f [ 127 | a: 1 128 | b 129 | c: 'bla 130 | d 131 | e: 'bla 132 | ] 133 | ] 134 | [ 135 | f: func [ 136 | "This is a test function" 137 | a [number!] "A number" 138 | b [any-word!] "A word" 139 | ] [ 140 | rejoin ["A: " mold a " B: " mold b] 141 | ] 142 | apply :f [a: 1 b: 'word] 143 | ] 144 | [apply :f [a: 'word b: 1]] 145 | [apply/only :f [1 word]] 146 | [apply/only :f [word 1]] 147 | [apply :f object none [a: 1 b: 'word]] 148 | [apply :f object none [a: 'word b: 1]] 149 | [apply :f context [a: 1 b: 'word]] 150 | [apply :f context [a: 'word b: 1]] 151 | [ 152 | mold a: action [ 153 | "Test action" 154 | a 155 | b 156 | ] [ 157 | number!: [ 158 | rejoin ["Number A, with B of type " mold type-of :b] 159 | ] 160 | string!: action [ 161 | number!: [ 162 | rejoin ["String A, number B"] 163 | ] 164 | string!: [ 165 | rejoin ["String A, string B"] 166 | ] 167 | ] 168 | default: [ 169 | rejoin ["Unexpected type: " mold type-of :a] 170 | ] 171 | ] 172 | ] 173 | [a 1 2] 174 | [a "one" 2] 175 | [a "one" "two"] 176 | [a 1 "two"] 177 | [a 'one 2] 178 | [a 'one 'two] 179 | [a 1 'two] 180 | [ 181 | ; RETURN not working on actions 182 | a: action [a b return: a] [ 183 | number!: [return a "Skipped"] 184 | ] 185 | a 1 2 186 | ] 187 | [ 188 | ; Cannot RETURN a single value 189 | f: func [a return: a] [return a] 190 | f 1 191 | ] 192 | [mold context-of :f] 193 | [spec-of :f] 194 | [body-of :f] 195 | -------------------------------------------------------------------------------- /topaz/tests/natives.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for native functions" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [do [pick [1 2 3] 1]] 8 | [load "1 2 3"] 9 | [reduce [1 2 3]] 10 | [mold reduce [get 'datatype! :make :func append [1 2 3] 4]] 11 | [load "1 2 3 ; 4 5 6^/ 7 8 9"] 12 | [write %test.txt "This is a test"] 13 | [read %test.txt] 14 | [save %test.topaz [] [This is a test]] 15 | [read %test.topaz] 16 | [load %test.topaz] 17 | [cause-error "An error"] 18 | [catch [throw "Something" none]] 19 | [if true ["Was true"]] 20 | [if false ["Was true"]] 21 | [either true ["Was true"] ["Was false"]] 22 | [either false ["Was true"] ["Was false"]] 23 | [not true] 24 | [not none] 25 | [i: 0 blk: [] while [i < 10] [append blk i i: i + 1] blk] 26 | [all [true false none]] 27 | [all [true false cause-error "Not here"]] 28 | [any [false true]] 29 | [any [none "Default"]] 30 | [case [1 < 0 ["Wrong"] 1 > 0 ["Correct"]]] 31 | [read %next/types] 32 | [type-of word!] 33 | [type-of 1] 34 | [type-of 'word] 35 | [type-of "String"] 36 | [find [1 2 3] 2] 37 | [find [a b c] 'b] 38 | [find [a b c] 'd] 39 | [switch-default 'a [a [1] b [2] c d [3]] [4]] 40 | [switch-default 'b [a [1] b [2] c d [3]] [4]] 41 | [switch-default 'c [a [1] b [2] c d [3]] [4]] 42 | [switch-default 'd [a [1] b [2] c d [3]] [4]] 43 | [switch-default 'e [a [1] b [2] c d [3]] [4]] 44 | ; bug with skip 45 | [empty? skip [] 1] 46 | [ 47 | a: 1 48 | until [ 49 | a: a + 1 50 | a = 5 51 | ] 52 | a 53 | ] 54 | [compose [a b (1 + 1) d]] 55 | [try [make datatype! none] 'error [error]] 56 | 57 | [mold [1 2 3]] 58 | 59 | [mold [1 60 | 2 3]] 61 | 62 | [mold/options [value: [1 63 | 2 3] indent: "X"]] 64 | 65 | [mold/options [value: [1 66 | 2 [3 4 67 | 5] 6] indent: "X"]] 68 | 69 | [mold/only [1 2 3]] 70 | 71 | [mold/only [1 72 | 2 3]] 73 | 74 | [mold/options [value: [1 75 | 2 3] indent: "X" only]] 76 | 77 | [mold/options [value: [1 78 | 2 [3 4 79 | 5] 6] indent: "X" only]] 80 | 81 | [mold/flat [1 2 3]] 82 | 83 | [mold/flat [1 84 | 2 3]] 85 | 86 | [mold/options [value: [1 87 | 2 3] indent: "X" flat]] 88 | 89 | [mold/options [value: [1 90 | 2 [3 4 91 | 5] 6] indent: "X" flat]] 92 | 93 | [compose [1 2 ([3 4]) 5 6]] 94 | [compose/only [1 2 ([3 4]) 5 6]] 95 | [compose/deep [1 2 [3 (2 + 2)] 5 6]] 96 | [compose/deep/only [1 2 [3 ([4])] 5 6]] 97 | [make error! none] 98 | [map 'x copy [1 2 3 4] [x + 1]] 99 | [punctuate copy [a b c] #","] 100 | -------------------------------------------------------------------------------- /topaz/tests/objects-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %objects.topaz" 3 | Type: 'Test-Results 4 | Passed: 14 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: "object none [^/ one: 1^/ two: 2^/ three: 3^/ flag: true^/]" 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: 1 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: 3 23 | ] object none [ 24 | passed?: true 25 | unhandled-throw?: false 26 | caused-error?: false 27 | result: true 28 | ] object none [ 29 | passed?: true 30 | unhandled-throw?: false 31 | caused-error?: false 32 | result: none 33 | ] object none [ 34 | passed?: true 35 | unhandled-throw?: false 36 | caused-error?: false 37 | result: 5 38 | ] object none [ 39 | passed?: true 40 | unhandled-throw?: false 41 | caused-error?: false 42 | result: "object none [^/ one: 1^/ two: 2^/ three: 3^/ flag: true^/ five: 5^/]" 43 | ] object none [ 44 | passed?: true 45 | unhandled-throw?: false 46 | caused-error?: false 47 | result: "object object none [^/ one: 1^/ two: 2^/ three: 3^/ flag: true^/ five: 5^/] [^/ four: 4^/]" 48 | ] object none [ 49 | passed?: true 50 | unhandled-throw?: false 51 | caused-error?: false 52 | result: 1 53 | ] object none [ 54 | passed?: true 55 | unhandled-throw?: false 56 | caused-error?: false 57 | result: 4 58 | ] object none [ 59 | passed?: true 60 | unhandled-throw?: false 61 | caused-error?: false 62 | result: 5 63 | ] object none [ 64 | passed?: true 65 | unhandled-throw?: false 66 | caused-error?: false 67 | result: true 68 | ] object none [ 69 | passed?: true 70 | unhandled-throw?: false 71 | caused-error?: false 72 | result: true 73 | ] object none [ 74 | passed?: true 75 | unhandled-throw?: false 76 | caused-error?: false 77 | result: false 78 | ] -------------------------------------------------------------------------------- /topaz/tests/objects.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for OBJECT! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [ 8 | mold obj: object none [ 9 | one: 1 10 | two: 2 11 | three: 1 + 2 12 | flag 13 | ] 14 | ] 15 | [obj/one] 16 | [obj/three] 17 | [obj/flag] 18 | [obj/four] 19 | [obj/five: 5] 20 | [mold obj] 21 | [mold obj2: object obj [four: 4]] 22 | [obj2/one] 23 | [obj2/four] 24 | [obj2/five] 25 | ['four in obj2] 26 | ['five in obj] 27 | ['four in obj] 28 | -------------------------------------------------------------------------------- /topaz/tests/parse-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %parse.topaz" 3 | Type: 'Test-Results 4 | Passed: 15 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: 1 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: 2 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: 3 23 | ] object none [ 24 | passed?: true 25 | unhandled-throw?: false 26 | caused-error?: false 27 | result: none 28 | ] object none [ 29 | passed?: true 30 | unhandled-throw?: false 31 | caused-error?: false 32 | result: none 33 | ] object none [ 34 | passed?: true 35 | unhandled-throw?: false 36 | caused-error?: false 37 | result: 3 38 | ] object none [ 39 | passed?: true 40 | unhandled-throw?: false 41 | caused-error?: false 42 | result: 3 43 | ] object none [ 44 | passed?: true 45 | unhandled-throw?: false 46 | caused-error?: false 47 | result: [1 2 3] 48 | ] object none [ 49 | passed?: true 50 | unhandled-throw?: false 51 | caused-error?: false 52 | result: [prin: funcall-macro 'prin [text] print: funcall-macro 'print [text] _foreach: funcall-macro '_foreach [arr fnc] foreach: none foreach-blk: none topaz-value: none] 53 | ] object none [ 54 | passed?: true 55 | unhandled-throw?: false 56 | caused-error?: false 57 | result: "e" 58 | ] object none [ 59 | passed?: true 60 | unhandled-throw?: false 61 | caused-error?: false 62 | result: "b" 63 | ] object none [ 64 | passed?: true 65 | unhandled-throw?: false 66 | caused-error?: false 67 | result: 'literal 68 | ] object none [ 69 | passed?: true 70 | unhandled-throw?: false 71 | caused-error?: false 72 | result: none 73 | ] object none [ 74 | passed?: true 75 | unhandled-throw?: false 76 | caused-error?: false 77 | result: 1 78 | ] object none [ 79 | passed?: true 80 | unhandled-throw?: false 81 | caused-error?: false 82 | result: 'a 83 | ] -------------------------------------------------------------------------------- /topaz/tests/parse.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for the PARSE function" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [parse [1 2 3] [number!]] 8 | [parse [1 2 3] [number! number!]] 9 | [parse [1 2 3] [number! number! number!]] 10 | [parse [1 2 3] [number! number! number! number!]] 11 | [parse [1 2 3] [word!]] 12 | [parse [1 2 3] [some number!]] 13 | [parse [1 2 3] [any number!]] 14 | [parse [1 2 3] [collect some [keep number!]]] 15 | [ 16 | parse [ 17 | prin: function [text] [] [ 18 | apply sys/print [text] 19 | text 20 | ] 21 | print: function [text] [] [ 22 | apply sys/print [text + "^/"] 23 | text 24 | ] 25 | 26 | _foreach: function [arr fnc] [] [ 27 | apply arr/for-each [fnc] 28 | ] 29 | macro 'foreach [word arr body] [ 30 | word: word/value 31 | if not system/words/block? word [word: system/words/reduce [word]] 32 | system/words/make system/words/expression! compose/only [ 33 | _foreach arr function (word) [] body 34 | ] 35 | ] 36 | ; _foreach-blk defined in types/block.topaz 37 | macro 'foreach-blk [word block body] [ 38 | word: word/value 39 | if not system/words/block? word [word: system/words/reduce [word]] 40 | system/words/make system/words/expression! compose/only [ 41 | _foreach-blk block function (word) [] body 42 | ] 43 | ] 44 | 45 | macro 'topaz-value [value] [ 46 | value: system/words/mold value/value 47 | system/words/make system/words/expression! compose [ 48 | load make string! (value) 49 | ] 50 | ] 51 | ] [ 52 | collect any [ 53 | name: set-word! 'function 54 | keep (name) keep ('funcall-macro) keep (make lit-word! name) 55 | keep/only block! block! block! 56 | | 57 | 'macro name: lit-word! block! block! keep (make set-word! name) keep ('none) 58 | | 59 | skip 60 | ] 61 | ] 62 | ] 63 | [mold parse [a [b c d] e] [word! into [some word!] word!]] 64 | [mold parse [a b c d] [word! [number!] | word! word!]] 65 | [parse [literal] [literal literal]] 66 | [parse [1 2 3] [literal literal]] 67 | [parse [1 2 3] [opt word! number!]] 68 | [parse [a b c] [opt word!]] 69 | -------------------------------------------------------------------------------- /topaz/tests/paths-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %paths.topaz" 3 | Type: 'Test-Results 4 | Passed: 4 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: "a/path" 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: "a/b/c" 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: "a/b/c:" 23 | ] object none [ 24 | passed?: true 25 | unhandled-throw?: false 26 | caused-error?: false 27 | result: "'a/b/c" 28 | ] -------------------------------------------------------------------------------- /topaz/tests/paths.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for PATH!, SET-PATH! and LIT-PATH! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [mold 'a/path] 8 | [mold make path! [a b c]] 9 | [mold make set-path! [a b c]] 10 | [mold make lit-path! [a b c]] 11 | -------------------------------------------------------------------------------- /topaz/tests/run.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Run Topaz tests" 3 | Author: "Gabriele Santilli" 4 | Copyright: 2011 5 | ; License: { 6 | ; Permission is hereby granted, free of charge, to any person obtaining 7 | ; a copy of this software and associated documentation files 8 | ; (the "Software"), to deal in the Software without restriction, including 9 | ; without limitation the rights to use, copy, modify, merge, publish, 10 | ; distribute, sublicense, and/or sell copies of the Software, and to 11 | ; permit persons to whom the Software is furnished to do so, subject 12 | ; to the following conditions: 13 | 14 | ; The above copyright notice and this permission notice shall be included 15 | ; in all copies or substantial portions of the Software. 16 | 17 | ; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS 18 | ; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 19 | ; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 20 | ; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR 21 | ; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 22 | ; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 23 | ; OTHER DEALINGS IN THE SOFTWARE. 24 | ; } 25 | ] 26 | 27 | tests-dir: %topaz/tests/ 28 | 29 | tests: map 'file read tests-dir [ 30 | if all [ 31 | test: attempt [load/header make file! rejoin [tests-dir file]] 32 | test/0/Type = 'Tests 33 | ] [ 34 | test/0/File: file 35 | test 36 | ] 37 | ] 38 | 39 | check-test: func [ 40 | "Ask the user to check the test results" 41 | test [block!] 42 | caused-error? [logic!] 43 | result 44 | options: 45 | message [string! none!] 46 | 47 | return: passed? [logic!] 48 | ] [ 49 | prin "^->> " print mold/options [ 50 | value: test 51 | only 52 | indent: "^->> " 53 | limit: 1024 54 | ] 55 | if message [ 56 | print rejoin ["^-" message] 57 | ] 58 | either caused-error? [ 59 | print form-error result 60 | ] [ 61 | prin "^-== " probe/options [ 62 | value: :result 63 | indent: "^-== " 64 | limit: 1024 65 | ] 66 | ] 67 | print "" 68 | false ; "p" = ask "^-[P]assed or [F]ailed: " 69 | ] 70 | 71 | run-tests: func [ 72 | "Run a set of tests" 73 | header [object!] 74 | tests [block!] 75 | 76 | return: 77 | passed [number!] 78 | failed [number!] 79 | ] [ 80 | print rejoin [header/Title " (" mold header/File ", " length-of tests " tests)"] 81 | passed: 0 82 | failed: 0 83 | results-file: make file! rejoin [tests-dir slice header/File skip tail header/File -6 %-results.topaz] 84 | ; this really begs to be a table!; the REDUCE is a temporary hack 85 | results: any [attempt [reduce load results-file] copy []] 86 | foreach 'test tests [ 87 | unhandled-throw?: yes 88 | caused-error?: no 89 | thrown: catch [ 90 | result: try test 'error [ 91 | caused-error?: yes 92 | error 93 | ] 94 | unhandled-throw?: no 95 | ] 96 | last-result: results/0 97 | case [ 98 | unhandled-throw? [ 99 | result: thrown 100 | either all [ 101 | last-result 102 | last-result/passed? 103 | last-result/unhandled-throw? 104 | last-result/result = result 105 | ] [ 106 | passed?: yes 107 | ] [ 108 | passed?: check-test/options [ 109 | test: test 110 | caused-error?: caused-error? 111 | result: result 112 | message: "UNHANDLED THROW:" 113 | ] 114 | ] 115 | ] 116 | caused-error? [ 117 | either all [ 118 | last-result 119 | last-result/passed? 120 | last-result/caused-error? 121 | last-result/result = result 122 | ] [ 123 | passed?: yes 124 | ] [ 125 | passed?: check-test test true result 126 | ] 127 | ] 128 | all [last-result last-result/result = result] [ 129 | passed?: last-result/passed? 130 | ] 131 | 'else [ 132 | passed?: check-test test caused-error? result 133 | ] 134 | ] 135 | either passed? [ 136 | passed: passed + 1 137 | ] [ 138 | failed: failed + 1 139 | ] 140 | ; do not overwrite if it passed last time (ie. keep good result rather than forgetting it) 141 | if any [ 142 | not last-result 143 | not last-result/passed? 144 | ] [ 145 | results/0: object none [ 146 | passed?: passed? 147 | unhandled-throw?: unhandled-throw? 148 | caused-error?: caused-error? 149 | result: result 150 | ] 151 | ] 152 | results: next results 153 | ] 154 | clear results 155 | save results-file [ 156 | Title: rejoin ["Test results for " mold header/File] 157 | Type: 'Test-Results 158 | Passed: passed 159 | Failed: failed 160 | ] head results 161 | prin "^-PASSED: " print mold passed 162 | prin "^-FAILED: " print mold failed 163 | print "" 164 | return passed failed 165 | ] 166 | 167 | total-passed: total-failed: 0 168 | foreach 'test tests [ 169 | if block? test [ 170 | set [passed failed] run-tests test/0 next test 171 | total-passed: total-passed + passed 172 | total-failed: total-failed + failed 173 | ] 174 | ] 175 | prin "TOTAL PASSED: " print mold total-passed 176 | prin "TOTAL FAILED: " print mold total-failed 177 | -------------------------------------------------------------------------------- /topaz/tests/scalars-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %scalars.topaz" 3 | Type: 'Test-Results 4 | Passed: 3 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: #"@" 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: 64 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: 1 23 | ] -------------------------------------------------------------------------------- /topaz/tests/scalars.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for NUMBER!, CHAR! and EXPRESSION! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [make char! 64] 8 | [make number! 64] 9 | [ 10 | e: make expression! [1] 11 | e/value 12 | ] 13 | -------------------------------------------------------------------------------- /topaz/tests/strings-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %strings.topaz" 3 | Type: 'Test-Results 4 | Passed: 3 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: "0" 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: false 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: true 23 | ] -------------------------------------------------------------------------------- /topaz/tests/strings.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for STRING! and FILE! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [make string! 0] 8 | ["String 1" = "String 2"] 9 | ["String 1" <> "String 2"] 10 | -------------------------------------------------------------------------------- /topaz/tests/typesets-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %typesets.topaz" 3 | Type: 'Test-Results 4 | Passed: 4 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: "make typeset! [word! get-word! set-word! lit-word!]" 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: "make typeset! [path! set-path! lit-path! block! paren!]" 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: true 23 | ] object none [ 24 | passed?: true 25 | unhandled-throw?: false 26 | caused-error?: false 27 | result: false 28 | ] -------------------------------------------------------------------------------- /topaz/tests/typesets.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for TYPESET! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [mold any-word!] 8 | [mold any-block!] 9 | [word! in any-word!] 10 | [block! in any-word!] 11 | -------------------------------------------------------------------------------- /topaz/tests/words-results.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Test results for %words.topaz" 3 | Type: 'Test-Results 4 | Passed: 24 5 | Failed: 0 6 | ] 7 | 8 | object none [ 9 | passed?: true 10 | unhandled-throw?: false 11 | caused-error?: false 12 | result: 1 13 | ] object none [ 14 | passed?: true 15 | unhandled-throw?: false 16 | caused-error?: false 17 | result: "a-word" 18 | ] object none [ 19 | passed?: true 20 | unhandled-throw?: false 21 | caused-error?: false 22 | result: datatype! 23 | ] object none [ 24 | passed?: true 25 | unhandled-throw?: false 26 | caused-error?: false 27 | result: "native [^/ ^"Make a Topaz type according to spec^"^/ type [datatype!]^/ spec^/ return: value ^"A value of the specified type^"^/]" 28 | ] object none [ 29 | passed?: true 30 | unhandled-throw?: false 31 | caused-error?: false 32 | result: "native [^/ ^"Insert a value at the current position of the series^"^/ series [series!]^/ value^/ options:^/ only: no [logic!] ^"Insert series as a single value^"^/ new-line: no [logic!] ^"Temporary - add new line before value on MOLD^"^/ return: series^/]" 33 | ] object none [ 34 | passed?: true 35 | unhandled-throw?: false 36 | caused-error?: false 37 | result: block! 38 | ] object none [ 39 | passed?: true 40 | unhandled-throw?: false 41 | caused-error?: false 42 | result: "func [^/ ^"Make a function^"^/ spec [block!] ^"Function arguments specification^"^/ body [block!]^/ return: function [function!]^/] [^/ make function! reduce [spec body]^/]" 43 | ] object none [ 44 | passed?: true 45 | unhandled-throw?: false 46 | caused-error?: false 47 | result: datatype! 48 | ] object none [ 49 | passed?: true 50 | unhandled-throw?: false 51 | caused-error?: false 52 | result: "native [^/ ^"Make a Topaz type according to spec^"^/ type [datatype!]^/ spec^/ return: value ^"A value of the specified type^"^/]" 53 | ] object none [ 54 | passed?: true 55 | unhandled-throw?: false 56 | caused-error?: false 57 | result: "native [^/ ^"Insert a value at the current position of the series^"^/ series [series!]^/ value^/ options:^/ only: no [logic!] ^"Insert series as a single value^"^/ new-line: no [logic!] ^"Temporary - add new line before value on MOLD^"^/ return: series^/]" 58 | ] object none [ 59 | passed?: true 60 | unhandled-throw?: false 61 | caused-error?: false 62 | result: block! 63 | ] object none [ 64 | passed?: true 65 | unhandled-throw?: false 66 | caused-error?: false 67 | result: "func [^/ ^"Make a function^"^/ spec [block!] ^"Function arguments specification^"^/ body [block!]^/ return: function [function!]^/] [^/ make function! reduce [spec body]^/]" 68 | ] object none [ 69 | passed?: true 70 | unhandled-throw?: false 71 | caused-error?: false 72 | result: "bla" 73 | ] object none [ 74 | passed?: true 75 | unhandled-throw?: false 76 | caused-error?: false 77 | result: "bla:" 78 | ] object none [ 79 | passed?: true 80 | unhandled-throw?: false 81 | caused-error?: false 82 | result: "'bla" 83 | ] object none [ 84 | passed?: true 85 | unhandled-throw?: false 86 | caused-error?: false 87 | result: true 88 | ] object none [ 89 | passed?: true 90 | unhandled-throw?: false 91 | caused-error?: false 92 | result: true 93 | ] object none [ 94 | passed?: true 95 | unhandled-throw?: false 96 | caused-error?: false 97 | result: false 98 | ] object none [ 99 | passed?: true 100 | unhandled-throw?: false 101 | caused-error?: true 102 | result: make error! [ 103 | category: 'Script 104 | id: 'invalid-argument 105 | message: "Invalid argument for MAKE WORD!" 106 | args: 1 107 | stack: [[make word! 1]] 108 | ] 109 | ] object none [ 110 | passed?: true 111 | unhandled-throw?: false 112 | caused-error?: false 113 | result: 'word! 114 | ] object none [ 115 | passed?: true 116 | unhandled-throw?: false 117 | caused-error?: false 118 | result: word! 119 | ] object none [ 120 | passed?: true 121 | unhandled-throw?: false 122 | caused-error?: false 123 | result: 'name 124 | ] object none [ 125 | passed?: true 126 | unhandled-throw?: false 127 | caused-error?: true 128 | result: make error! [ 129 | category: 'Script 130 | id: 'no-value 131 | message: "Word has no value" 132 | args: 'no-value 133 | stack: [[get 'no-value]] 134 | ] 135 | ] object none [ 136 | passed?: true 137 | unhandled-throw?: false 138 | caused-error?: false 139 | result: none 140 | ] -------------------------------------------------------------------------------- /topaz/tests/words.topaz: -------------------------------------------------------------------------------- 1 | Topaz [ 2 | Title: "Tests for WORD!, SET-WORD!, LIT-WORD! and GET-WORD! values" 3 | Author: "Gabriele Santilli" 4 | Type: Tests 5 | ] 6 | 7 | [a: 1 a] 8 | [mold 'a-word] 9 | [get 'datatype!] 10 | [mold get 'make] 11 | [mold get 'insert] 12 | [get 'block!] 13 | [mold get 'func] 14 | [:datatype!] 15 | [mold :make] 16 | [mold :insert] 17 | [:block!] 18 | [mold :func] 19 | [mold make word! "bla"] 20 | [mold make set-word! "bla"] 21 | [mold make lit-word! "bla"] 22 | ['word = first [word]] 23 | ['word = first [word:]] 24 | ['word1 = 'word2] 25 | [make word! 1] 26 | [make word! word!] 27 | [type-of make word! word!] 28 | [make lit-word! first [name:]] 29 | [get 'no-value] 30 | [get/any 'no-value] 31 | -------------------------------------------------------------------------------- /topaz/try-topaz.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | Try Topaz 6 | 53 | 54 | 55 |

Try Topaz

56 |

Topaz language interpreter by Gabriele Santilli. © 2011 - MIT License

57 |

Source code 58 | Clear console

59 |
60 | 63 | 64 |
65 | 

66 |      
67 |   
68 | 
69 | 


--------------------------------------------------------------------------------
/topaz/types/char.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: CHAR!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: CHAR! ==========================================================
29 | 
30 | make-type 'char! [
31 |     make: function [arguments] [] [
32 |         make-struct [
33 |             type: char!
34 |             string: arguments
35 |         ]
36 |     ]
37 |     topaz-make: function [value] [] [
38 |         switch-default value/type/name [
39 |             "number!" [
40 |                 apply char!/make [to-char value/number]
41 |             ]
42 |             "char!" [
43 |                 apply char!/make [value/string]
44 |             ]
45 |             "none!" [
46 |                 apply char!/make [to-char 0]
47 |             ]
48 |         ] [
49 |             error make-struct [
50 |                 category: "Script"
51 |                 id: "invalid-argument"
52 |                 message: "Invalid argument for MAKE CHAR!"
53 |                 args: value
54 |             ]
55 |         ]
56 |     ]
57 |     mold: function [
58 |         "Return a LOAD-able text representation of a value"
59 |         char
60 |         options:
61 |             only: no [logic!] "Don't generate outer [ ] for block! values"
62 |             flat: no [logic!] "Produce a single text line"
63 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
64 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
65 |     ] [] [
66 |         limit-string rejoin ["#^"" escape char/string "^""] limit
67 |     ]
68 |     do: function [char block] [] [
69 |         reduce [char skip block 1]
70 |     ]
71 |     bind: :default-bind
72 |     compile: function [char block] [] [
73 |         reduce [ast-value char skip block 1]
74 |     ]
75 |     equal?: :default-equal?
76 |     copy: function [value] [] [value]
77 | ]
78 | char!/("char!"): make-struct [
79 |     equal?: function [char1 char2] [] [char1/string = char2/string]
80 | ]
81 | 
82 | parse-char: function [text] [ch] [
83 |     ch: exec-re to-js-string text regexp "^^#^"(\^^?.|\^^\([0-9A-Fa-f]+\))^"" ""
84 |     if ch [
85 |         reduce [
86 |             make char! unescape pick-array ch 1
87 |             skip text length-of-array pick-array ch 0
88 |         ]
89 |     ]
90 | ]
91 | 


--------------------------------------------------------------------------------
/topaz/types/context.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: CONTEXT!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: CONTEXT! =======================================================
 29 | 
 30 | make-type 'context! [
 31 |     make: function [arguments] [ctx] [
 32 |         if not arguments [arguments: make-struct []]
 33 |         ctx: make-struct [
 34 |             type: context!
 35 |             words: any [arguments/words make-array]
 36 |             values: any [arguments/values make-array]
 37 |             compiler-values: make-array
 38 |         ]
 39 |         set-in-context ctx make word! "this-context" ctx
 40 |         ctx
 41 |     ]
 42 |     topaz-make: function [code] [ctx] [
 43 |         switch-default code/type/name [
 44 |             "block!" [
 45 |                 ctx: make context! none
 46 |                 bind/new collect-set-words make block! none code ctx
 47 |                 do bind code ctx
 48 |                 ctx
 49 |             ]
 50 |         ] [
 51 |             error make-struct [
 52 |                 category: "Script"
 53 |                 id: "invalid-argument"
 54 |                 message: "Invalid argument for MAKE CONTEXT!"
 55 |                 args: code
 56 |             ]
 57 |         ]
 58 |     ]
 59 |     mold: function [
 60 |         "Return a LOAD-able text representation of a value"
 61 |         context
 62 |         options:
 63 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 64 |             flat: no [logic!] "Produce a single text line"
 65 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 66 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 67 |     ] [] [
 68 |         mold-words-and-values [
 69 |             open: "context ["
 70 |             close: either flat ["]"] [rejoin ["^/" indent "]"]]
 71 |             limit: limit
 72 |             words: copy-array context/words 1
 73 |             get-word-f: function [word] [] [context/values/(get-word-offset context word)]
 74 |             sep: either flat [" "] [rejoin ["^/" indent "    "]]
 75 |             flat: flat
 76 |             indent: rejoin [indent "    "]
 77 |         ]
 78 |     ]
 79 |     do: function [context block] [] [
 80 |         reduce [context skip block 1]
 81 |     ]
 82 |     bind: :default-bind
 83 |     compile: function [context block] [] [
 84 |         reduce [ast-value context skip block 1]
 85 |     ]
 86 |     get-path: function [context selector] [offset] [
 87 |         if any [not any-word? selector  0 > offset: get-word-offset context selector/word] [
 88 |             error make-struct [
 89 |                 category: "Script"
 90 |                 id: "invalid-path"
 91 |                 message: "Invalid path value"
 92 |                 args: selector
 93 |             ]
 94 |         ]
 95 |         pick-array context/values offset
 96 |     ]
 97 |     set-path: function [context selector set-to] [offset] [
 98 |         if any [not any-word? selector  0 > offset: get-word-offset context selector/word] [
 99 |             error make-struct [
100 |                 category: "Script"
101 |                 id: "invalid-path"
102 |                 message: "Invalid path value"
103 |                 args: selector
104 |             ]
105 |         ]
106 |         poke-array context/values offset set-to
107 |     ]
108 |     equal?: :default-equal?
109 |     in?: function [ctx word] [offset] [
110 |         if not any-word? word [
111 |             error make-struct [
112 |                 category: "Script"
113 |                 id: "invalid-argument"
114 |                 message: "Invalid argument for IN? CONTEXT!"
115 |                 args: word
116 |             ]
117 |         ]
118 |         either 0 > offset: get-word-offset ctx word/word [
119 |             make none! none
120 |         ] [
121 |             make-word word/type word/word make-struct [
122 |                 context: ctx
123 |                 offset: offset
124 |             ]
125 |         ]
126 |     ]
127 | ]
128 | 
129 | get-word-offset: function [context word] [] [
130 |     apply context/words/index-of [word]
131 | ]
132 | 
133 | add-word: function [context word value] [l] [
134 |     l: length-of-array context/words
135 |     poke-array context/words l word/word
136 |     poke-array context/values l value
137 |     l
138 | ]
139 | 
140 | bind-word: function [context word add?] [offset] [
141 |     offset: get-word-offset context word/word
142 |     if all [add? offset < 0] [
143 |         offset: add-word context word none
144 |     ]
145 |     either offset >= 0 [
146 |         make-word word/type word/word make-struct [
147 |             context: context
148 |             offset: offset
149 |         ]
150 |     ] [
151 |         word
152 |     ]
153 | ]
154 | 
155 | set-in-context: function [context word set-to] [offset] [
156 |     either 0 > offset: get-word-offset context word/word [
157 |         add-word context word set-to
158 |     ] [
159 |         poke-array context/values offset set-to
160 |     ]
161 | ]
162 | 
163 | mold-words-and-values: function [
164 |     open
165 |     close
166 |     limit
167 |     words
168 |     get-word-f
169 |     sep
170 |     flat
171 |     indent
172 | ] [result i value] [
173 |     result: open
174 |     i: 0
175 |     while [all [
176 |         within-limit? result limit
177 |         i < length-of-array words
178 |     ]] [
179 |         result: rejoin [
180 |             result sep
181 |             words/:i ": "
182 |         ]
183 |         if within-limit? result limit [
184 |             either value: apply get-word-f [words/:i] [
185 |                 result: rejoin [
186 |                     result
187 |                     mold/options [
188 |                         value: either word? value [make lit-word! value/word] [value]
189 |                         flat: flat
190 |                         limit: subtract-limit result limit
191 |                         indent: indent
192 |                     ]
193 |                 ]
194 |             ] [
195 |                 result: rejoin [result ""]
196 |             ]
197 |         ]
198 |         i: i + 1
199 |     ]
200 |     if within-limit? result limit [
201 |         result: rejoin [result close]
202 |     ]
203 |     limit-string result limit
204 | ]
205 | 
206 | context-to-object: function [context] [words map] [
207 |     map: make-struct []
208 |     foreach [word pos] words: copy-array context/words 1 [
209 |         map/(word): context/values/(pos + 1)
210 |     ]
211 |     make object! make-struct [
212 |         words: words
213 |         map: :map
214 |     ]
215 | ]
216 | 
217 | get-compiler-value: function [word] [] [
218 |     either word/context [
219 |         any [word/context/compiler-values/(word/offset) make none! none]
220 |     ] [
221 |         make none! none
222 |     ]
223 | ]
224 | set-compiler-value: function [word value] [] [
225 |     if not word/context [
226 |         error make-struct [
227 |             category: "Script"
228 |             id: "no-context"
229 |             message: "Word has no context"
230 |             args: word
231 |         ]
232 |     ]
233 |     word/context/compiler-values/(word/offset): value
234 |     value
235 | ]
236 | 


--------------------------------------------------------------------------------
/topaz/types/datatype.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: DATATYPE!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: DATATYPE! ======================================================
29 | 
30 | ; datatype! has a circular reference
31 | datatype!: none
32 | 
33 | datatypes: make-array
34 | 
35 | ; make-type is defined as a macro in compile-topaz.topaz
36 | 
37 | make-type 'datatype! [
38 |     mold: function [
39 |         "Return a LOAD-able text representation of a value"
40 |         type
41 |         options:
42 |             only: no [logic!] "Don't generate outer [ ] for block! values"
43 |             flat: no [logic!] "Produce a single text line"
44 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
45 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
46 |     ] [] [
47 |         limit-string type/name limit
48 |     ]
49 |     do: function [type block] [] [
50 |         reduce [type skip block 1]
51 |     ]
52 |     bind: :default-bind
53 |     topaz-make: function [ignored] [] [
54 |         error make-struct [
55 |             category: "Internal"
56 |             id: "not-implemented"
57 |             message: "Cannot make datatypes (yet)"
58 |         ]
59 |     ]
60 |     compile: function [type block] [] [
61 |         reduce [ast-value type skip block 1]
62 |     ]
63 |     equal?: function [type value] [] [false]
64 | ]
65 | datatype!/("datatype!"): make-struct [
66 |     equal?: function [type1 type2] [] [type1/name = type2/name]
67 | ]
68 | 
69 | ; fix the circular reference
70 | datatype!/type: datatype!
71 | 


--------------------------------------------------------------------------------
/topaz/types/error.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: ERROR!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: ERROR! =========================================================
 29 | 
 30 | make-type 'error! [
 31 |     make: function [args] [res] [
 32 |         if not args [args: make-struct []]
 33 |         res: make-struct [
 34 |             type: error!
 35 |             category: any [args/category "Internal"]
 36 |             id: any [args/id "unspecified"]
 37 |             message: any [args/message "Unspecified error"]
 38 |             args: args/args
 39 |             stack: make block! none
 40 |         ]
 41 |         if args/stack [insert/only res/stack args/stack]
 42 |         res
 43 |     ]
 44 |     topaz-make: function [value] [blk] [
 45 |         switch-default value/type/name [
 46 |             "block!" [
 47 |                 blk: make block! none
 48 |                 append blk make none! none
 49 |                 insert/only tail blk value
 50 |                 topaz-make-error apply object!/topaz-make [blk]
 51 |             ]
 52 |             "object!" [
 53 |                 topaz-make-error value
 54 |             ]
 55 |             "error!" [value]
 56 |         ] [
 57 |             apply error!/make [make-struct [
 58 |                 category: "Script"
 59 |                 id: "invalid-argument"
 60 |                 message: "Invalid argument for MAKE ERROR!"
 61 |                 args: value
 62 |             ]]
 63 |         ]
 64 |     ]
 65 |     mold: function [
 66 |         "Return a LOAD-able text representation of a value"
 67 |         err
 68 |         options:
 69 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 70 |             flat: no [logic!] "Produce a single text line"
 71 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 72 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 73 |     ] [result] [
 74 |         limit-string either flat [
 75 |             rejoin [
 76 |                 "make error! [category: '" err/category " id: '" err/id " "
 77 |                 "message: ^"" escape err/message "^" "
 78 |                 either err/args [
 79 |                     rejoin [
 80 |                         "args: " mold/options [
 81 |                             value: either word? err/args [make lit-word! err/args/word] [err/args]
 82 |                             flat
 83 |                             limit: limit
 84 |                         ] " "
 85 |                     ]
 86 |                 ] [""]
 87 |                 "stack: " mold/options [value: err/stack flat limit: limit] "]"
 88 |             ]
 89 |         ] [
 90 |             rejoin [
 91 |                 "make error! [^/"
 92 |                 indent "    category: '" err/category "^/"
 93 |                 indent "    id: '" err/id "^/"
 94 |                 indent "    message: ^"" escape err/message "^"^/"
 95 |                 either err/args [
 96 |                     rejoin [
 97 |                         indent "    args: " mold/options [
 98 |                             value: either word? err/args [make lit-word! err/args/word] [err/args]
 99 |                             indent: indent + "    "
100 |                             limit: limit
101 |                         ] "^/"
102 |                     ]
103 |                 ] [""]
104 |                 indent "    stack: " mold/options [value: err/stack limit: limit indent: indent + "    "] "^/"
105 |                 indent "]"
106 |             ]
107 |         ] limit
108 |     ]
109 |     do: function [err block] [] [
110 |         reduce [err skip block 1]
111 |     ]
112 |     bind: :default-bind
113 |     compile: function [err block] [] [
114 |         reduce [ast-value err skip block 1]
115 |     ]
116 |     equal?: :default-equal?
117 |     copy: function [value] [] [value]
118 | ]
119 | error!/("error!"): make-struct [
120 |     equal?: function [err1 err2] [] [
121 |         all [
122 |             err1/category = err2/category
123 |             err1/id = err2/id
124 |         ]
125 |     ]
126 | ]
127 | 
128 | topaz-make-error: function [obj] [args err] [
129 |     obj: obj/map
130 |     args: make-struct []
131 |     if obj/category [
132 |         args/category: either obj/category/type/name = "word!" [obj/category/word] [none]
133 |     ]
134 |     if obj/id [
135 |         args/id: either obj/id/type/name = "word!" [obj/id/word] [none]
136 |     ]
137 |     if obj/message [
138 |         args/message: either obj/message/type/name = "string!" [obj/message/string] [none]
139 |     ]
140 |     if all [obj/args not none? obj/args] [
141 |         args/args: obj/args
142 |     ]
143 |     err: apply error!/make [args]
144 |     if all [obj/stack block? obj/stack] [
145 |         err/stack: obj/stack
146 |     ]
147 |     err
148 | ]
149 | 
150 | error: function [args] [] [
151 |     throw apply error!/make [args]
152 | ]
153 | form-error: function [err] [res] [
154 |     res: rejoin [
155 |         "*** " err/category " error: " err/message
156 |         either err/args [
157 |             either all [err/category = "Internal" string? err/args] [
158 |                 ; JS error
159 |                 rejoin [": " err/args/string]
160 |             ] [
161 |                 rejoin [": " mold/options [value: err/args flat limit: 80]]
162 |             ]
163 |         ] [""]
164 |     ]
165 |     foreach 'item err/stack/values [
166 |         either all [err/category = "Internal" string? item] [
167 |             ; JS error
168 |             res: rejoin [res "^/*** JS Stack:^/" item/string "^/"]
169 |         ] [
170 |             res: rejoin [res "^/*** Stack: " mold/options [value: item only limit: 160 indent: "         : "]]
171 |         ]
172 |     ]
173 |     res
174 | ]
175 | 


--------------------------------------------------------------------------------
/topaz/types/expression.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: EXPRESSION!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: EXPRESSION! ====================================================
29 | 
30 | ; (This is a temporary type used for compiler macros.)
31 | 
32 | make-type 'expression! [
33 |     make: function [arguments] [] [
34 |         make-struct [
35 |             type: expression!
36 |             expr: arguments
37 |         ]
38 |     ]
39 |     topaz-make: function [code] [] [
40 |         either code/type/name = "block!" [
41 |             code: compile code
42 |             if 1 = length-of-array code/list [code: pick-array code/list 0]
43 |             apply expression!/make [code]
44 |         ] [
45 |             error make-struct [
46 |                 category: "Script"
47 |                 id: "invalid-argument"
48 |                 message: "Invaild argument for MAKE EXPRESSION!"
49 |                 args: code
50 |             ]
51 |         ]
52 |     ]
53 |     mold: function [
54 |         "Return a LOAD-able text representation of a value"
55 |         expr
56 |         options:
57 |             only: no [logic!] "Don't generate outer [ ] for block! values"
58 |             flat: no [logic!] "Produce a single text line"
59 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
60 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
61 |     ] [js] [
62 |         try [js: to-js expr/expr "statement"] 'e [js: "TO-JS error"]
63 |         limit-string rejoin ["#[expr " expr/expr/node-type " {" js "}]"] limit
64 |     ]
65 |     do: function [expr block] [] [
66 |         reduce [expr skip block 1]
67 |     ]
68 |     bind: :default-bind
69 |     compile: function [expr block] [] [
70 |         reduce [expr/expr skip block 1]
71 |     ]
72 |     equal?: :default-equal?
73 |     get-path: function [expr selector] [] [
74 |         if any [
75 |             selector/type/name <> "word!"
76 |             selector/word <> "value"
77 |             not test-re expr/expr/node-type regexp "^^value\/.*" ""
78 |         ] [
79 |             error make-struct [
80 |                 category: "Script"
81 |                 id: "invalid-path"
82 |                 message: "Invalid path value"
83 |                 args: selector
84 |             ]
85 |         ]
86 |         expr/expr/value
87 |     ]
88 |     copy: function [value] [] [value]
89 | ]
90 | 


--------------------------------------------------------------------------------
/topaz/types/file.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: FILE!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: FILE! ==========================================================
 29 | 
 30 | ; This is temporarily just a string; however, I have plans to change this.
 31 | 
 32 | make-type 'file! [
 33 |     make: function [arguments] [] [make-string file! arguments 0]
 34 |     topaz-make: function [value] [] [
 35 |         switch-default value/type/name [
 36 |             "none!" [make-string file! "" 0]
 37 |             "string!" [make-string file! to-js-string value 0]
 38 |             "file!" [make-string file! to-js-string value 0]
 39 |         ] [
 40 |             make-string file! mold value 0
 41 |         ]
 42 |     ]
 43 |     length-of: function [string] [] [
 44 |         (length-of-array string/string) - string/pos
 45 |     ]
 46 |     pick: function [string pos] [] [
 47 |         pick-array string/string string/pos + pos
 48 |     ]
 49 |     skip: function [string amount] [] [
 50 |         make-string file! string/string string/pos + amount
 51 |     ]
 52 |     tail: function [string] [] [
 53 |         make-string file! string/string length-of-array string/string
 54 |     ]
 55 |     mold: function [
 56 |         "Return a LOAD-able text representation of a value"
 57 |         string
 58 |         options:
 59 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 60 |             flat: no [logic!] "Produce a single text line"
 61 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 62 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 63 |     ] [] [
 64 |         ; PROBLEM: does not MOLD files with spaces correctly
 65 |         limit-string rejoin ["%" escape limit-string string/string limit] limit
 66 |     ]
 67 |     do: function [string block] [] [
 68 |         reduce [string skip block 1]
 69 |     ]
 70 |     bind: :default-bind
 71 |     compile: function [string block] [] [
 72 |         reduce [ast-value string skip block 1]
 73 |     ]
 74 |     equal?: :default-equal?
 75 |     copy: function [string] [] [
 76 |         make-string file! to-js-string string 0
 77 |     ]
 78 |     slice: :slice-string
 79 | ]
 80 | file!/("string!"): make-struct [
 81 |     equal?: :equal-string?
 82 | ]
 83 | file!/("file!"): make-struct [
 84 |     equal?: :equal-string?
 85 | ]
 86 | 
 87 | parse-file: function [text] [t] [
 88 |     if #"%" = pick text 0 [
 89 |         t: exec-re to-js-string text regexp "^^%(([^^^^\f\n\r \])]*|\^^\([0-9A-Fa-f]+\)|\^^[^^\f\n\r])*)" ""
 90 |         either t [
 91 |             reduce [
 92 |                 make file! unescape pick-array t 1
 93 |                 skip text length-of-array pick-array t 0
 94 |             ]
 95 |         ] [
 96 |             error make-struct [
 97 |                 category: "Internal"
 98 |                 id: "should-not-happen"
 99 |                 message: "This should not happen (parse-file, no match)"
100 |                 stack: text
101 |             ]
102 |         ]
103 |     ]
104 | ]
105 | 


--------------------------------------------------------------------------------
/topaz/types/get-word.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: GET-WORD!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: GET-WORD! ======================================================
29 | 
30 | make-type 'get-word! [
31 |     make: function [arguments] [] [make-word get-word! arguments none]
32 |     topaz-make: function [value] [] [topaz-make-word get-word! value]
33 |     mold: function [
34 |         "Return a LOAD-able text representation of a value"
35 |         word
36 |         options:
37 |             only: no [logic!] "Don't generate outer [ ] for block! values"
38 |             flat: no [logic!] "Produce a single text line"
39 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
40 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
41 |     ] [] [limit-string ":" + word/word limit]
42 |     do: function [word block] [] [
43 |         reduce [get word skip block 1]
44 |     ]
45 |     bind: function [
46 |         "Bind words to a specified context"
47 |         word
48 |         context [context!]
49 |         options:
50 |             copy: no [logic!] "Bind a (deep) copy of WORDS"
51 |             new: no [logic!] "Add all words to CONTEXT"
52 |     ] [] [bind-word context word new]
53 |     compile: function [word block] [] [
54 |         reduce [ast-get word skip block 1]
55 |     ]
56 |     equal?: :default-equal?
57 | ]
58 | get-word!/("word!"): make-struct [
59 |     equal?: :compare-words
60 | ]
61 | get-word!/("get-word!"): make-struct [
62 |     equal?: :compare-words
63 | ]
64 | get-word!/("set-word!"): make-struct [
65 |     equal?: :compare-words
66 | ]
67 | get-word!/("lit-word!"): make-struct [
68 |     equal?: :compare-words
69 | ]
70 | 
71 | parse-get-word: function [text] [w] [
72 |     if all [#":" = first text  w: parse-word-chars skip text 1] [
73 |         reduce [
74 |             make get-word! w
75 |             skip text 1 + length-of-array w
76 |         ]
77 |     ]
78 | ]
79 | 


--------------------------------------------------------------------------------
/topaz/types/lit-path.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: LIT-PATH!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: LIT-PATH! ======================================================
 29 | 
 30 | make-type 'lit-path! [
 31 |     make: function [arguments] [] [make-path lit-path! arguments]
 32 |     topaz-make: function [value] [] [topaz-make-path lit-path! value]
 33 |     insert: :insert-path
 34 |     head: :head-path
 35 |     tail: :tail-path
 36 |     skip: :skip-path
 37 |     pick: :pick-block
 38 |     length-of: :length-of-block
 39 |     mold: function [
 40 |         "Return a LOAD-able text representation of a value"
 41 |         block
 42 |         options:
 43 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 44 |             flat: no [logic!] "Produce a single text line"
 45 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 46 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 47 |     ] [] [
 48 |         mold-values [
 49 |             open: "'"
 50 |             close: ""
 51 |             sep: "/"
 52 |             flat: true
 53 |             nlsep: "/"
 54 |             indent: ""
 55 |             limit: limit
 56 |             only: false
 57 |             values: block/values
 58 |             newlines: make-array
 59 |             pos: block/pos
 60 |         ]
 61 |     ]
 62 |     do: function [path block] [] [
 63 |         reduce [copy-path path! path skip block 1]
 64 |     ]
 65 |     bind: :bind-block
 66 |     compile: function [path block] [] [
 67 |         reduce [
 68 |             ast-value make-struct [
 69 |                 type: path!
 70 |                 values: path/values
 71 |                 pos: path/pos
 72 |             ]
 73 |             skip block 1
 74 |         ]
 75 |     ]
 76 |     equal?: :default-equal?
 77 |     copy: function [value] [] [copy-path lit-path! value]
 78 |     slice: :slice-path
 79 | ]
 80 | lit-path!/("path!"): make-struct [
 81 |     equal?: :compare-blocks
 82 | ]
 83 | lit-path!/("set-path!"): make-struct [
 84 |     equal?: :compare-blocks
 85 | ]
 86 | lit-path!/("lit-path!"): make-struct [
 87 |     equal?: :compare-blocks
 88 | ]
 89 | 
 90 | parse-lit-path: function [text] [path value] [
 91 |     if all [#"'" = first text  value: parse-word-chars skip text 1  #"/" = pick text 1 + length-of-array value] [
 92 |         path: make lit-path! none
 93 |         path: insert path make word! value
 94 |         text: skip text 1 + length-of-array value
 95 |         while [all [not empty? text  #"/" = first text]] [
 96 |             set [value text] parse-path-element skip text 1
 97 |             either value [
 98 |                 path: insert/only path value
 99 |             ] [
100 |                 error make-struct [
101 |                     category: "Syntax"
102 |                     id: "load-error"
103 |                     message: "Parse error"
104 |                     stack: text
105 |                 ]
106 |             ]
107 |         ]
108 |         reduce [head path text]
109 |     ]
110 | ]
111 | 


--------------------------------------------------------------------------------
/topaz/types/lit-word.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: LIT-WORD!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: LIT-WORD! ======================================================
29 | 
30 | make-type 'lit-word! [
31 |     make: function [arguments] [] [make-word lit-word! arguments none]
32 |     topaz-make: function [value] [] [topaz-make-word lit-word! value]
33 |     mold: function [
34 |         "Return a LOAD-able text representation of a value"
35 |         word
36 |         options:
37 |             only: no [logic!] "Don't generate outer [ ] for block! values"
38 |             flat: no [logic!] "Produce a single text line"
39 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
40 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
41 |     ] [] [limit-string "'" + word/word limit]
42 |     do: function [word block] [] [
43 |         reduce [convert-word word word! skip block 1]
44 |     ]
45 |     bind: function [
46 |         "Bind words to a specified context"
47 |         word
48 |         context [context!]
49 |         options:
50 |             copy: no [logic!] "Bind a (deep) copy of WORDS"
51 |             new: no [logic!] "Add all words to CONTEXT"
52 |     ] [] [bind-word context word new]
53 |     compile: function [word block] [] [
54 |         reduce [
55 |             ast-value convert-word word word!
56 |             skip block 1
57 |         ]
58 |     ]
59 |     equal?: :default-equal?
60 | ]
61 | lit-word!/("word!"): make-struct [
62 |     equal?: :compare-words
63 | ]
64 | lit-word!/("get-word!"): make-struct [
65 |     equal?: :compare-words
66 | ]
67 | lit-word!/("set-word!"): make-struct [
68 |     equal?: :compare-words
69 | ]
70 | lit-word!/("lit-word!"): make-struct [
71 |     equal?: :compare-words
72 | ]
73 | 
74 | parse-lit-word: function [text] [w] [
75 |     if all [#"'" = first text  w: parse-word-chars skip text 1] [
76 |         reduce [
77 |             make lit-word! w
78 |             skip text 1 + length-of-array w
79 |         ]
80 |     ]
81 | ]
82 | 


--------------------------------------------------------------------------------
/topaz/types/logic.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: LOGIC!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: LOGIC! =========================================================
29 | 
30 | make-type 'logic! [
31 |     make: function [value] [] [
32 |         either value [true-value] [false-value]
33 |     ]
34 |     topaz-make: function [value] [] [
35 |         switch-default value/type/name [
36 |             "none!" [false-value]
37 |             "logic!" [value]
38 |         ] [
39 |             true-value
40 |         ]
41 |     ]
42 |     mold: function [
43 |         "Return a LOAD-able text representation of a value"
44 |         value
45 |         options:
46 |             only: no [logic!] "Don't generate outer [ ] for block! values"
47 |             flat: no [logic!] "Produce a single text line"
48 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
49 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
50 |     ] [] [
51 |         limit-string either value/value ["true"] ["false"] limit
52 |     ]
53 |     do: function [value block] [] [
54 |         reduce [value skip block 1]
55 |     ]
56 |     bind: :default-bind
57 |     compile: function [value block] [] [
58 |         reduce [ast-value value skip block 1]
59 |     ]
60 |     equal?: :default-equal?
61 | ]
62 | logic!/("logic!"): make-struct [
63 |     equal?: function [logic1 logic2] [] [logic1/value = logic2/value]
64 | ]
65 | 
66 | true-value: make-struct [
67 |     type: logic!
68 |     value: true
69 | ]
70 | false-value: make-struct [
71 |     type: logic!
72 |     value: false
73 | ]
74 | 


--------------------------------------------------------------------------------
/topaz/types/native.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: NATIVE!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: NATIVE! ========================================================
 29 | 
 30 | make-type 'native! [
 31 |     make: function [arguments] [fnc] [
 32 |         fnc: make-func-object native! arguments/0
 33 |         fnc/arguments: make-array
 34 |         fnc/func: arguments/1
 35 |         fnc/compile: arguments/2
 36 |         parse-function-spec fnc
 37 |         fnc
 38 |     ]
 39 |     topaz-make: function [block] [spec name f c] [
 40 |         if not block? block [
 41 |             error make-struct [
 42 |                 category: "Script"
 43 |                 id: "invalid-argument"
 44 |                 message: "Invalid argument for MAKE NATIVE!"
 45 |                 args: block
 46 |             ]
 47 |         ]
 48 |         if 2 <> length-of block [
 49 |             error make-struct [
 50 |                 category: "Script"
 51 |                 id: "invalid-spec"
 52 |                 message: "MAKE NATIVE! requires a spec and a name, not"
 53 |                 args: block
 54 |             ]
 55 |         ]
 56 |         if not block? spec: first block [
 57 |             error make-struct [
 58 |                 category: "Script"
 59 |                 id: "invalid-spec"
 60 |                 message: "Native spec must be a BLOCK!, not"
 61 |                 args: spec/type
 62 |             ]
 63 |         ]
 64 |         if not word? name: second block [
 65 |             error make-struct [
 66 |                 category: "Script"
 67 |                 id: "invalid-spec"
 68 |                 message: "Native name must be a WORD!, not"
 69 |                 args: name/type
 70 |             ]
 71 |         ]
 72 |         name: name/word
 73 |         f: natives/(name-to-js name)
 74 |         c: native-compilers/(name-to-js name)
 75 |         apply native!/make [reduce [spec f c]]
 76 |     ]
 77 |     mold: function [
 78 |         "Return a LOAD-able text representation of a value"
 79 |         func
 80 |         options:
 81 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 82 |             flat: no [logic!] "Produce a single text line"
 83 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 84 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 85 |     ] [] [
 86 |         limit-string rejoin ["native " mold/options [value: func/spec flat: flat limit: limit indent: indent]] limit
 87 |     ]
 88 |     do: :function-do
 89 |     prepare-arguments: function [func] [] [clone-array func/arguments]
 90 |     call: function [func args] [] [
 91 |         if not func/func [
 92 |             error make-struct [
 93 |                 category: "Internal"
 94 |                 id: "not-implemented"
 95 |                 message: "This is a compiler-only native"
 96 |             ]
 97 |         ]
 98 |         apply func/func/apply [none args]
 99 |     ]
100 |     bind: :default-bind
101 |     compile: function [func block] [] [function-compile func block false]
102 |     call-compile: function [func args] [] [
103 |         if not func/compile [
104 |             error make-struct [
105 |                 category: "Internal"
106 |                 id: "not-implemented"
107 |                 message: "This is a interpreter-only native"
108 |             ]
109 |         ]
110 |         apply func/compile/apply [none args]
111 |     ]
112 |     equal?: :default-equal?
113 |     get-path: :function-get-path
114 |     set-argument: function [func args arg value] [] [
115 |         args/(arg/offset): value
116 |         args
117 |     ]
118 |     get-argument: function [func args arg] [] [args/(arg/offset)]
119 |     add-argument: function [func arg dflt] [] [
120 |         arg/offset: length-of-array func/arguments
121 |         apply func/arguments/push [dflt]
122 |     ]
123 |     set-return: function [func spec] [] []
124 |     compile-default-arguments: function [func args wrap?] [] [
125 |         ; prepare default arguments
126 |         foreach [value pos] args [
127 |             if value [
128 |                 ; only immediate values supported
129 |                 args/(pos): either wrap? [make expression! ast-value value] [ast-value value]
130 |             ]
131 |         ]
132 |     ]
133 | ]
134 | 


--------------------------------------------------------------------------------
/topaz/types/none.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: NONE!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: NONE! ==========================================================
29 | 
30 | make-type 'none! [
31 |     make: function [ignored] [] [none-value]
32 |     topaz-make: function [ignored] [] [none-value]
33 |     mold: function [
34 |         "Return a LOAD-able text representation of a value"
35 |         value
36 |         options:
37 |             only: no [logic!] "Don't generate outer [ ] for block! values"
38 |             flat: no [logic!] "Produce a single text line"
39 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
40 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
41 |     ] [] [
42 |         limit-string "none" limit
43 |     ]
44 |     do: function [value block] [] [
45 |         reduce [value skip block 1]
46 |     ]
47 |     bind: :default-bind
48 |     compile: function [value block] [] [
49 |         reduce [ast-value value skip block 1]
50 |     ]
51 |     equal?: :default-equal?
52 |     copy: function [value] [] [value]
53 | ]
54 | none!/("none!"): make-struct [
55 |     equal?: function [val1 val2] [] [true]
56 | ]
57 | 
58 | none-value: make-struct [
59 |     type: none!
60 | ]
61 | 


--------------------------------------------------------------------------------
/topaz/types/number.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: NUMBER!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: NUMBER! ========================================================
29 | 
30 | make-type 'number! [
31 |     make: function [arguments] [] [
32 |         make-struct [
33 |             type: number!
34 |             number: arguments
35 |         ]
36 |     ]
37 |     topaz-make: function [value] [] [
38 |         switch-default value/type/name [
39 |             "none!" [
40 |                 apply number!/make [0]
41 |             ]
42 |             "number!" [
43 |                 value
44 |             ]
45 |             "string!" [
46 |                 apply number!/make [apply parse-float [value/string]]
47 |             ]
48 |             "char!" [
49 |                 apply number!/make [apply value/string/char-code-at [0]]
50 |             ]
51 |             "logic!" [
52 |                 apply number!/make [value/value + 0]
53 |             ]
54 |         ] [
55 |             error make-struct [
56 |                 category: "Script"
57 |                 id: "invalid-argument"
58 |                 message: "Invalid argument for MAKE NUMBER!"
59 |                 args: value
60 |             ]
61 |         ]
62 |     ]
63 |     mold: function [
64 |         "Return a LOAD-able text representation of a value"
65 |         number
66 |         options:
67 |             only: no [logic!] "Don't generate outer [ ] for block! values"
68 |             flat: no [logic!] "Produce a single text line"
69 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
70 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
71 |     ] [] [
72 |         limit-string apply number/number/to-string [] limit
73 |     ]
74 |     do: function [number block] [] [
75 |         reduce [number skip block 1]
76 |     ]
77 |     bind: :default-bind
78 |     compile: function [number block] [] [
79 |         reduce [ast-value number skip block 1]
80 |     ]
81 |     equal?: :default-equal?
82 | ]
83 | number!/("number!"): make-struct [
84 |     equal?: function [num1 num2] [] [num1/number = num2/number]
85 | ]
86 | 
87 | parse-number: function [text] [t] [
88 |     t: exec-re to-js-string text regexp "^^[-+]?[0-9]+(\.[0-9]*)?([Ee][-+]?[0-9]{1,3})?" ""
89 |     if all [t  0 < length-of-array t: pick-array t 0] [
90 |         reduce [
91 |             make number! apply parse-float [t]
92 |             skip text length-of-array t
93 |         ]
94 |     ]
95 | ]
96 | 


--------------------------------------------------------------------------------
/topaz/types/object.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: OBJECT!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: OBJECT! ========================================================
 29 | 
 30 | make-type 'object! [
 31 |     make: function [args] [] [
 32 |         if not args [args: make-struct []]
 33 |         make-struct [
 34 |             type: object!
 35 |             parent: args/parent
 36 |             words: any [args/words make-array]
 37 |             map: any [args/map make-struct []]
 38 |         ]
 39 |     ]
 40 |     topaz-make: function [code] [obj parent] [
 41 |         switch-default code/type/name [
 42 |             "block!" [
 43 |                 parent: first code
 44 |                 case [
 45 |                     parent/type/name = "none!" [parent: none]
 46 |                     parent/type/name <> "object!" [
 47 |                         error make-struct [
 48 |                             category: "Script"
 49 |                             id: "invalid-spec"
 50 |                             message: "Invalid object parent"
 51 |                             args: parent
 52 |                         ]
 53 |                     ]
 54 |                 ]
 55 |                 obj: make object! make-struct [parent: parent]
 56 |                 parse-object-spec obj second code
 57 |             ]
 58 |             "object!" [
 59 |                 obj: make object! make-struct [parent: code]
 60 |             ]
 61 |         ] [
 62 |             error make-struct [
 63 |                 category: "Script"
 64 |                 id: "invalid-argument"
 65 |                 message: "Invalid argument for MAKE OBJECT!"
 66 |                 args: code
 67 |             ]
 68 |         ]
 69 |         obj
 70 |     ]
 71 |     mold: function [
 72 |         "Return a LOAD-able text representation of a value"
 73 |         obj
 74 |         options:
 75 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 76 |             flat: no [logic!] "Produce a single text line"
 77 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 78 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 79 |     ] [result] [
 80 |         either only [
 81 |             result: "["
 82 |         ] [
 83 |             result: "object "
 84 |             if within-limit? result limit [
 85 |                 result: rejoin [
 86 |                     result
 87 |                     either obj/parent [
 88 |                         mold/options [
 89 |                             value: obj/parent
 90 |                             flat: flat
 91 |                             limit: if limit [limit - length-of-array result]
 92 |                             indent: indent
 93 |                         ]
 94 |                     ] [
 95 |                         "none"
 96 |                     ]
 97 |                     " ["
 98 |                 ]
 99 |             ]
100 |         ]
101 |         mold-words-and-values [
102 |             open: result
103 |             close: either flat ["]"] [rejoin ["^/" indent "]"]]
104 |             limit: limit
105 |             words: obj/words
106 |             get-word-f: function [word] [] [obj/map/:word]
107 |             sep: either flat [" "] [rejoin ["^/" indent "    "]]
108 |             flat: flat
109 |             indent: rejoin [indent "    "]
110 |         ]
111 |     ]
112 |     do: function [object block] [] [
113 |         reduce [object skip block 1]
114 |     ]
115 |     bind: :default-bind
116 |     compile: function [object block] [] [
117 |         reduce [ast-value object skip block 1]
118 |     ]
119 |     get-path: function [object selector] [] [
120 |         if not any-word? selector [
121 |             error make-struct [
122 |                 category: "Script"
123 |                 id: "invalid-path"
124 |                 message: "Invalid path value"
125 |                 args: selector
126 |             ]
127 |         ]
128 |         get-word-in-object object selector/word
129 |     ]
130 |     set-path: function [object selector set-to] [] [
131 |         if not any-word? selector [
132 |             error make-struct [
133 |                 category: "Script"
134 |                 id: "invalid-path"
135 |                 message: "Invalid path value"
136 |                 args: selector
137 |             ]
138 |         ]
139 |         set-word-in-object object selector/word set-to
140 |     ]
141 |     equal?: :default-equal?
142 |     in?: function [object word] [] [
143 |         if not any-word? word [
144 |             error make-struct [
145 |                 category: "Script"
146 |                 id: "invalid-argument"
147 |                 message: "Invalid argument for IN? OBJECT!"
148 |                 args: word
149 |             ]
150 |         ]
151 |         make logic! either object/map/(word/word) [true] [false]
152 |     ]
153 | ]
154 | 
155 | in-object?: function [obj word] [] [
156 |     0 <= apply obj/words/index-of [word]
157 | ]
158 | 
159 | set-word-in-object: function [object word set-to] [] [
160 |     if not in-object? object word [append-array object/words word]
161 |     object/map/(word): set-to
162 | ]
163 | get-word-in-object: function [object word] [] [
164 |     any [object/map/:word either object/parent [get-word-in-object object/parent word] [make none! none]]
165 | ]
166 | 
167 | parse-object-spec: function [obj spec] [word value] [
168 |     while [not empty? spec] [
169 |         word: first spec
170 |         switch-default word/type/name [
171 |             "set-word!" [
172 |                 set [value spec] do-step second spec next spec
173 |                 set-word-in-object obj word/word value
174 |             ]
175 |             "word!" [
176 |                 spec: next spec
177 |                 set-word-in-object obj word/word make logic! true
178 |             ]
179 |         ] [
180 |             error make-struct [
181 |                 category: "Script"
182 |                 id: "invalid-spec"
183 |                 message: "Invalid object spec value"
184 |                 args: word
185 |                 stack: spec
186 |             ]
187 |         ]
188 |     ]
189 |     obj
190 | ]
191 | 
192 | export-object-to-context: function [object context] [] [
193 |     if object/parent [export-object-to-context object/parent context]
194 |     foreach 'word object/words [
195 |         set-in-context context make word! word object/map/:word
196 |     ]
197 |     none
198 | ]
199 | 


--------------------------------------------------------------------------------
/topaz/types/op.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: OP!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: OP! ============================================================
 29 | 
 30 | make-type 'op! [
 31 |     make: function [arguments] [] [
 32 |         if 2 <> arguments/mandatory [
 33 |             error make-struct [
 34 |                 category: "Script"
 35 |                 id: "invalid-argument"
 36 |                 message: "Function must take exactly two arguments"
 37 |             ]
 38 |         ]
 39 |         make-struct [
 40 |             type: op!
 41 |             func: arguments
 42 |         ]
 43 |     ]
 44 |     topaz-make: function [func] [] [
 45 |         switch-default func/type/name [
 46 |             "function!" [apply op!/make [func]]
 47 |             "native!" [apply op!/make [func]]
 48 |             "action!" [apply op!/make [func]]
 49 |         ] [
 50 |             error make-struct [
 51 |                 category: "Script"
 52 |                 id: "invalid-argument"
 53 |                 message: "Invalid argument for MAKE OP!"
 54 |                 args: func
 55 |             ]
 56 |         ]
 57 |     ]
 58 |     mold: function [
 59 |         "Return a LOAD-able text representation of a value"
 60 |         op
 61 |         options:
 62 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 63 |             flat: no [logic!] "Produce a single text line"
 64 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 65 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 66 |     ] [] [
 67 |         limit-string rejoin ["make op! " mold/options [value: op/func flat: flat limit: limit indent: indent]] limit
 68 |     ]
 69 |     do: function [op block] [] [
 70 |         error make-struct [
 71 |             category: "Script"
 72 |             id: "invalid-infix"
 73 |             message: "Infix use of OP!s is not supported"
 74 |         ]
 75 |     ]
 76 |     bind: :default-bind
 77 |     compile: function [op block] [] [
 78 |         error make-struct [
 79 |             category: "Compilation"
 80 |             id: "invalid-infix"
 81 |             message: "Infix use of OP!s is not supported"
 82 |         ]
 83 |     ]
 84 |     equal?: :default-equal?
 85 | ]
 86 | 
 87 | operator?: function [block] [value] [
 88 |     all [
 89 |         not empty? block
 90 |         word? value: first block
 91 |         value: get/any value
 92 |         op? value
 93 |         value
 94 |     ]
 95 | ]
 96 | do-op: function [op arg1 arg2] [args] [
 97 |     args: apply op/func/type/prepare-arguments [op/func]
 98 |     args: apply op/func/type/set-argument [op/func args op/func/args-list/0 arg1]
 99 |     args: apply op/func/type/set-argument [op/func args op/func/args-list/1 arg2]
100 |     apply op/func/type/call [op/func args]
101 | ]
102 | 


--------------------------------------------------------------------------------
/topaz/types/paren.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: PAREN!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: PAREN! =========================================================
29 | 
30 | make-type 'paren! [
31 |     make: function [arguments] [] [make-block paren! arguments]
32 |     topaz-make: function [value] [] [topaz-make-block paren! value]
33 |     insert: :insert-block
34 |     head: :head-block
35 |     tail: :tail-block
36 |     skip: :skip-block
37 |     pick: :pick-block
38 |     length-of: :length-of-block
39 |     mold: function [
40 |         "Return a LOAD-able text representation of a value"
41 |         block
42 |         options:
43 |             only: no [logic!] "Don't generate outer [ ] for block! values"
44 |             flat: no [logic!] "Produce a single text line"
45 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
46 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
47 |     ] [] [
48 |         mold-values [
49 |             open: "("
50 |             close: either block/newlines/(length-of-array block/values) [rejoin ["^/" indent ")"]] [")"]
51 |             sep: " "
52 |             flat: flat
53 |             nlsep: either flat [" "] [rejoin ["^/" indent "    "]]
54 |             indent: either flat [""] [rejoin [indent "    "]]
55 |             limit: limit
56 |             only: false
57 |             values: block/values
58 |             newlines: block/newlines
59 |             pos: block/pos
60 |         ]
61 |     ]
62 |     do: function [paren block] [] [
63 |         reduce [do paren skip block 1]
64 |     ]
65 |     bind: :bind-block
66 |     compile: function [paren block] [] [
67 |         reduce [ast-paren compile paren skip block 1]
68 |     ]
69 |     equal?: :default-equal?
70 |     copy: function [value] [] [copy-block paren! value]
71 |     slice: :slice-block
72 |     clear: :clear-block
73 | ]
74 | paren!/("paren!"): make-struct [
75 |     equal?: :compare-blocks
76 | ]
77 | paren!/("block!"): make-struct [
78 |     equal?: :compare-blocks
79 | ]
80 | 
81 | parse-paren: function [text] [values] [
82 |     if #"(" = first text [
83 |         set [values text] parse-values make paren! none skip text 1
84 |         if #")" <> first text [
85 |             error make-struct [
86 |                 category: "Syntax"
87 |                 id: "load-error"
88 |                 message: "Missing )"
89 |                 stack: text
90 |             ]
91 |         ]
92 |         reduce [values skip text 1]
93 |     ]
94 | ]
95 | 


--------------------------------------------------------------------------------
/topaz/types/path.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: PATH!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: PATH! ==========================================================
 29 | 
 30 | insert-path: function [
 31 |     "Insert a value at the current position of the series"
 32 |     path [any-path!]
 33 |     value
 34 |     options:
 35 |         only: no [logic!] "Insert series as a single value"
 36 |         new-line: no [logic!] "Temporary - add new line before value on MOLD"
 37 | ] [tmp] [
 38 |     either all [not only any-block? value] [
 39 |         insert-array2 path/values path/pos tmp: copy-array value/values value/pos
 40 |         make-path path/type make-struct [
 41 |             values: path/values
 42 |             pos: path/pos + length-of-array tmp
 43 |         ]
 44 |     ] [
 45 |         insert-array path/values path/pos value
 46 |         make-path path/type make-struct [
 47 |             values: path/values
 48 |             pos: path/pos + 1
 49 |         ]
 50 |     ]
 51 | ]
 52 | 
 53 | skip-path: function [path amount] [pos len] [
 54 |     pos: path/pos + amount
 55 |     case [
 56 |         pos > len: length-of-array path/values [pos: len]
 57 |         pos < 0 [pos: 0]
 58 |     ]
 59 |     make-path path/type make-struct [
 60 |         values: path/values
 61 |         pos: pos
 62 |     ]
 63 | ]
 64 | 
 65 | head-path: function [path] [] [
 66 |     make-path path/type make-struct [
 67 |         values: path/values
 68 |     ]
 69 | ]
 70 | 
 71 | tail-path: function [path] [] [
 72 |     make-path path/type make-struct [
 73 |         values: path/values
 74 |         pos: length-of-array path/values
 75 |     ]
 76 | ]
 77 | 
 78 | slice-path: function [
 79 |     "Copy part of a path"
 80 |     start [any-block!]
 81 |     end-or-length [any-block! number!]
 82 | ] [end] [
 83 |     either any-block? end-or-length [
 84 |         end: end-or-length/pos
 85 |     ] [
 86 |         end: start/pos + end-or-length/number
 87 |     ]
 88 |     make-path start/type make-struct [
 89 |         values: slice-array start/values start/pos end
 90 |     ]
 91 | ]
 92 | 
 93 | make-type 'path! [
 94 |     make: function [arguments] [] [make-path path! arguments]
 95 |     topaz-make: function [value] [] [topaz-make-path path! value]
 96 |     insert: :insert-path
 97 |     head: :head-path
 98 |     tail: :tail-path
 99 |     skip: :skip-path
100 |     pick: :pick-block
101 |     length-of: :length-of-block
102 |     mold: function [
103 |         "Return a LOAD-able text representation of a value"
104 |         block
105 |         options:
106 |             only: no [logic!] "Don't generate outer [ ] for block! values"
107 |             flat: no [logic!] "Produce a single text line"
108 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
109 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
110 |     ] [] [
111 |         mold-values [
112 |             open: ""
113 |             close: ""
114 |             sep: "/"
115 |             flat: true
116 |             nlsep: "/"
117 |             indent: ""
118 |             limit: limit
119 |             only: false
120 |             values: block/values
121 |             newlines: make-array
122 |             pos: block/pos
123 |         ]
124 |     ]
125 |     do: function [path block] [value] [
126 |         if empty? path [
127 |             error make-struct [
128 |                 category: "Script"
129 |                 id: "invalid-path"
130 |                 message: "Empty PATH! value"
131 |             ]
132 |         ]
133 |         value: get first path
134 |         path: skip path 1
135 |         while [not empty? path] [
136 |             value: get-path value first path
137 |             path: skip path 1
138 |         ]
139 |         either word-active? value [
140 |             apply value/type/do [value block]
141 |         ] [
142 |             reduce [value skip block 1]
143 |         ]
144 |     ]
145 |     bind: :bind-block
146 |     compile: function [path block] [value expr] [
147 |         if empty? path [
148 |             error make-struct [
149 |                 category: "Compilation"
150 |                 id: "invalid-path"
151 |                 message: "Empty PATH! value"
152 |             ]
153 |         ]
154 |         value: get/any first path
155 |         either all [value word-active? value] [
156 |             path: skip path 1
157 |             while [not empty? path] [
158 |                 value: get-path value first path
159 |                 path: skip path 1
160 |             ]
161 |             apply value/type/compile [value block]
162 |         ] [
163 |             expr: ast-get first path
164 |             path: skip path 1
165 |             while [not empty? path] [
166 |                 expr: ast-get-path expr first path
167 |                 path: skip path 1
168 |             ]
169 |             reduce [expr skip block 1]
170 |         ]
171 |     ]
172 |     equal?: :default-equal?
173 |     copy: function [value] [] [copy-path path! value]
174 |     slice: :slice-path
175 | ]
176 | path!/("path!"): make-struct [
177 |     equal?: :compare-blocks
178 | ]
179 | path!/("set-path!"): make-struct [
180 |     equal?: :compare-blocks
181 | ]
182 | path!/("lit-path!"): make-struct [
183 |     equal?: :compare-blocks
184 | ]
185 | 
186 | make-path: function [type args] [] [
187 |     if not args [args: make-struct []]
188 |     make-struct [
189 |         type: type
190 |         values: any [args/values make-array]
191 |         pos: any [args/pos 0]
192 |     ]
193 | ]
194 | 
195 | topaz-make-path: function [type value] [] [
196 |     switch-default value/type/name [
197 |         "block!"    [copy-path type value]
198 |         "paren!"    [copy-path type value]
199 |         "path!"     [copy-path type value]
200 |         "lit-path!" [copy-path type value]
201 |         "set-path!" [copy-path type value]
202 |     ] [make-path type none]
203 | ]
204 | 
205 | copy-path: function [type value] [] [
206 |     make-path type make-struct [
207 |         values: apply value/values/slice [value/pos]
208 |     ]
209 | ]
210 | 
211 | make-newlines: function [values] [newlines] [
212 |     newlines: make-array
213 |     foreach 'item values [
214 |         append-array newlines false
215 |     ]
216 |     newlines
217 | ]
218 | path-to-block: function [type value] [values] [
219 |     values: apply value/values/slice [value/pos]
220 |     make-block type make-struct [
221 |         values: values
222 |         newlines: make-newlines values
223 |     ]
224 | ]
225 | 
226 | parse-path: function [text] [path value] [
227 |     if all [value: parse-word-chars text  #"/" = pick text length-of-array value] [
228 |         path: make path! none
229 |         path: insert path make word! value
230 |         text: skip text length-of-array value
231 |         while [all [not empty? text  #"/" = first text]] [
232 |             set [value text] parse-path-element skip text 1
233 |             either value [
234 |                 path: insert/only path value
235 |             ] [
236 |                 error make-struct [
237 |                     category: "Syntax"
238 |                     id: "load-error"
239 |                     message: "Parse error"
240 |                     stack: text
241 |                 ]
242 |             ]
243 |         ]
244 |         reduce [head path text]
245 |     ]
246 | ]
247 | 


--------------------------------------------------------------------------------
/topaz/types/return-value.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: RETURN!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: RETURN-VALUE! ==================================================
29 | 
30 | ; This is an internal datatype
31 | 
32 | make-internal-type 'return-value! [
33 |     make: function [arguments] [] [
34 |         make-struct [
35 |             type: return-value!
36 |             value: arguments/value
37 |             func: arguments/func
38 |         ]
39 |     ]
40 |     topaz-make: function [] [] [should-not-happen "MAKE" "RETURN!"]
41 |     mold: function [] [] [should-not-happen "MOLD" "RETURN!"]
42 |     do: function [] [] [should-not-happen "DO" "RETURN!"]
43 |     bind: function [] [] [should-not-happen "BIND" "RETURN!"]
44 |     compile: function [] [] [should-not-happen "COMPILE" "RETURN!"]
45 |     equal?: :default-equal?
46 |     copy: function [value] [] [value]
47 | ]
48 | 


--------------------------------------------------------------------------------
/topaz/types/return.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: RETURN!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: RETURN! ========================================================
 29 | 
 30 | ; RETURN! values are special native functions which throw a RETURN-VALUE!
 31 | 
 32 | make-type 'return! [
 33 |     make: function [arguments] [fnc] [
 34 |         fnc: make-func-object return! arguments/spec
 35 |         fnc/func: arguments/func
 36 |         parse-function-spec fnc
 37 |         fnc
 38 |     ]
 39 |     topaz-make: function [ignored] [] [
 40 |         error make-struct [
 41 |             category: "Script"
 42 |             id: "invalid-argument"
 43 |             message: "Cannot MAKE RETURN!"
 44 |         ]
 45 |     ]
 46 |     mold: function [
 47 |         "Return a LOAD-able text representation of a value"
 48 |         func
 49 |         options:
 50 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 51 |             flat: no [logic!] "Produce a single text line"
 52 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 53 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 54 |     ] [] [
 55 |         limit-string rejoin [
 56 |             "#[return " mold/options [value: func/spec flat: flat limit: limit indent: indent] "]"
 57 |         ] limit
 58 |     ]
 59 |     do: :function-do
 60 |     prepare-arguments: function [func] [] [
 61 |         case [
 62 |             func/mandatory = 0 [
 63 |                 make none! none
 64 |             ]
 65 |             func/mandatory = 1 [
 66 |                 none
 67 |             ]
 68 |             'else [
 69 |                 make object! none
 70 |             ]
 71 |         ]
 72 |     ]
 73 |     call: function [func args] [] [
 74 |         throw make return-value! make-struct [value: args func: func/func]
 75 |     ]
 76 |     ; return can't be made into an op! so no call-two
 77 |     bind: :default-bind
 78 |     compile: function [func block] [args] [
 79 |         error make-struct [
 80 |             category: "Internal"
 81 |             id: "not-implemented"
 82 |             message: "Cannot compile RETURN! values"
 83 |         ]
 84 |     ]
 85 |     equal?: :default-equal?
 86 |     get-path: :function-get-path
 87 |     set-argument: function [func args arg value] [] [
 88 |         either func/mandatory = 1 [
 89 |             value
 90 |         ] [
 91 |             set-word-in-object args argument-name-of arg value
 92 |             args
 93 |         ]
 94 |     ]
 95 |     get-argument: function [func args arg] [] [
 96 |         either func/mandatory = 1 [args] [args/map/(argument-name-of arg)]
 97 |     ]
 98 |     add-argument: function [func arg dflt] [] []
 99 | ]
100 | 


--------------------------------------------------------------------------------
/topaz/types/set-path.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: SET-PATH!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: SET-PATH! ======================================================
 29 | 
 30 | make-type 'set-path! [
 31 |     make: function [arguments] [] [make-path set-path! arguments]
 32 |     topaz-make: function [value] [] [topaz-make-path set-path! value]
 33 |     insert: :insert-path
 34 |     head: :head-path
 35 |     tail: :tail-path
 36 |     skip: :skip-path
 37 |     pick: :pick-block
 38 |     length-of: :length-of-block
 39 |     mold: function [
 40 |         "Return a LOAD-able text representation of a value"
 41 |         block
 42 |         options:
 43 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 44 |             flat: no [logic!] "Produce a single text line"
 45 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 46 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 47 |     ] [] [
 48 |         mold-values [
 49 |             open: ""
 50 |             close: ":"
 51 |             sep: "/"
 52 |             flat: true
 53 |             nlsep: "/"
 54 |             indent: ""
 55 |             limit: limit
 56 |             only: false
 57 |             values: block/values
 58 |             newlines: make-array
 59 |             pos: block/pos
 60 |         ]
 61 |     ]
 62 |     do: function [path block] [value set-to] [
 63 |         if 2 > length-of path [
 64 |             error make-struct [
 65 |                 category: "Script"
 66 |                 id: "invalid-path"
 67 |                 message: "SET-PATH! with less than two values"
 68 |             ]
 69 |         ]
 70 |         value: get first path
 71 |         path: skip path 1
 72 |         while [1 < length-of path] [
 73 |             value: get-path value first path
 74 |             path: skip path 1
 75 |         ]
 76 |         block: skip block 1
 77 |         if empty? block [
 78 |             error make-struct [
 79 |                 category: "Script"
 80 |                 id: "missing-argument"
 81 |                 message: "SET-PATH! needs a value"
 82 |             ]
 83 |         ]
 84 |         set [set-to block] do-step first block block
 85 |         set-path value first path set-to
 86 |         reduce [set-to block]
 87 |     ]
 88 |     bind: :bind-block
 89 |     compile: function [path block] [expr set-to] [
 90 |         if 2 > length-of path [
 91 |             error make-struct [
 92 |                 category: "Compilation"
 93 |                 id: "invalid-path"
 94 |                 message: "SET-PATH! with less than two values"
 95 |             ]
 96 |         ]
 97 |         expr: ast-get first path
 98 |         path: skip path 1
 99 |         while [1 < length-of path] [
100 |             expr: ast-get-path expr first path
101 |             path: skip path 1
102 |         ]
103 |         block: skip block 1
104 |         if empty? block [
105 |             error make-struct [
106 |                 category: "Compilation"
107 |                 id: "missing-argument"
108 |                 message: "SET-PATH! needs a value"
109 |             ]
110 |         ]
111 |         set [set-to block] compile-step block
112 |         reduce [ast-set-path expr first path set-to block]
113 |     ]
114 |     equal?: :default-equal?
115 |     copy: function [value] [] [copy-path set-path! value]
116 |     slice: :slice-path
117 | ]
118 | set-path!/("path!"): make-struct [
119 |     equal?: :compare-blocks
120 | ]
121 | set-path!/("set-path!"): make-struct [
122 |     equal?: :compare-blocks
123 | ]
124 | set-path!/("lit-path!"): make-struct [
125 |     equal?: :compare-blocks
126 | ]
127 | 
128 | parse-set-path: function [text] [path value] [
129 |     if all [value: parse-word-chars text  #"/" = pick text length-of-array value] [
130 |         path: make set-path! none
131 |         path: insert path make word! value
132 |         text: skip text length-of-array value
133 |         while [all [not empty? text  #"/" = first text]] [
134 |             set [value text] parse-path-element skip text 1
135 |             either value [
136 |                 path: insert/only path value
137 |             ] [
138 |                 error make-struct [
139 |                     category: "Syntax"
140 |                     id: "load-error"
141 |                     message: "Parse error"
142 |                     stack: text
143 |                 ]
144 |             ]
145 |         ]
146 |         if all [not empty? text  #":" = first text] [
147 |             reduce [head path skip text 1]
148 |         ]
149 |     ]
150 | ]
151 | 


--------------------------------------------------------------------------------
/topaz/types/set-word.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: SET-WORD!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: SET-WORD! ======================================================
 29 | 
 30 | make-type 'set-word! [
 31 |     make: function [arguments] [] [make-word set-word! arguments none]
 32 |     topaz-make: function [value] [] [topaz-make-word set-word! value]
 33 |     mold: function [
 34 |         "Return a LOAD-able text representation of a value"
 35 |         word
 36 |         options:
 37 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 38 |             flat: no [logic!] "Produce a single text line"
 39 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 40 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 41 |     ] [] [limit-string word/word + #":" limit]
 42 |     do: function [word block] [set-to] [
 43 |         block: skip block 1
 44 |         if empty? block [
 45 |             error make-struct [
 46 |                 category: "Script"
 47 |                 id: "missing-argument"
 48 |                 message: "SET-WORD! needs a value"
 49 |             ]
 50 |         ]
 51 |         set [set-to block] do-step first block block
 52 |         set-word word set-to
 53 |         reduce [set-to block]
 54 |     ]
 55 |     bind: function [
 56 |         "Bind words to a specified context"
 57 |         word
 58 |         context [context!]
 59 |         options:
 60 |             copy: no [logic!] "Bind a (deep) copy of WORDS"
 61 |             new: no [logic!] "Add all words to CONTEXT"
 62 |     ] [] [bind-word context word new]
 63 |     compile: function [word block] [set-to] [
 64 |         block: skip block 1
 65 |         if empty? block [
 66 |             error make-struct [
 67 |                 category: "Compilation"
 68 |                 id: "missing-argument"
 69 |                 message: "SET-WORD! needs a value"
 70 |             ]
 71 |         ]
 72 |         set [set-to block] compile-step block
 73 |         reduce [ast-set word set-to block]
 74 |     ]
 75 |     equal?: :default-equal?
 76 | ]
 77 | set-word!/("word!"): make-struct [
 78 |     equal?: :compare-words
 79 | ]
 80 | set-word!/("get-word!"): make-struct [
 81 |     equal?: :compare-words
 82 | ]
 83 | set-word!/("set-word!"): make-struct [
 84 |     equal?: :compare-words
 85 | ]
 86 | set-word!/("lit-word!"): make-struct [
 87 |     equal?: :compare-words
 88 | ]
 89 | 
 90 | set-word: function [word value] [] [
 91 |     if not word/context [
 92 |         error make-struct [
 93 |             category: "Script"
 94 |             id: "no-context"
 95 |             message: "Word has no context"
 96 |             args: word
 97 |         ]
 98 |     ]
 99 |     poke-array word/context/values word/offset value
100 |     value
101 | ]
102 | 
103 | parse-set-word: function [text] [w] [
104 |     if all [w: parse-word-chars text  #":" = pick text length-of-array w] [
105 |         reduce [
106 |             make set-word! w
107 |             skip text 1 + length-of-array w
108 |         ]
109 |     ]
110 | ]
111 | 


--------------------------------------------------------------------------------
/topaz/types/string.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: STRING!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: STRING! ========================================================
 29 | 
 30 | slice-string: function [
 31 |     "Copy part of a string"
 32 |     start [any-string!]
 33 |     end-or-length [any-string! number!]
 34 | ] [end] [
 35 |     either any-string? end-or-length [
 36 |         end: end-or-length/pos
 37 |     ] [
 38 |         end: start/pos + end-or-length/number
 39 |     ]
 40 |     make-string start/type slice-array start/string start/pos end 0
 41 | ]
 42 | 
 43 | make-type 'string! [
 44 |     make: function [arguments] [] [make-string string! arguments 0]
 45 |     topaz-make: function [value] [] [
 46 |         switch-default value/type/name [
 47 |             "none!" [make-string string! "" 0]
 48 |             "string!" [make-string string! to-js-string value 0]
 49 |             "file!" [make-string string! to-js-string value 0]
 50 |         ] [
 51 |             make-string string! mold value 0
 52 |         ]
 53 |     ]
 54 |     length-of: function [string] [] [
 55 |         (length-of-array string/string) - string/pos
 56 |     ]
 57 |     pick: function [string pos] [] [
 58 |         pick-array string/string string/pos + pos
 59 |     ]
 60 |     skip: function [string amount] [] [
 61 |         make-string string! string/string string/pos + amount
 62 |     ]
 63 |     tail: function [string] [] [
 64 |         make-string string! string/string length-of-array string/string
 65 |     ]
 66 |     mold: function [
 67 |         "Return a LOAD-able text representation of a value"
 68 |         string
 69 |         options:
 70 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 71 |             flat: no [logic!] "Produce a single text line"
 72 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 73 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 74 |     ] [] [
 75 |         limit-string rejoin ["^"" escape limit-string string/string limit #"^""] limit
 76 |     ]
 77 |     do: function [string block] [] [
 78 |         reduce [string skip block 1]
 79 |     ]
 80 |     bind: :default-bind
 81 |     compile: function [string block] [] [
 82 |         reduce [ast-value string skip block 1]
 83 |     ]
 84 |     equal?: :default-equal?
 85 |     copy: function [string] [] [
 86 |         make-string string! to-js-string string 0
 87 |     ]
 88 |     slice: :slice-string
 89 | ]
 90 | equal-string?: function [string1 string2] [] [
 91 |     (to-js-string string1) = to-js-string string2
 92 | ]
 93 | string!/("string!"): make-struct [
 94 |     equal?: :equal-string?
 95 | ]
 96 | string!/("file!"): make-struct [
 97 |     equal?: :equal-string?
 98 | ]
 99 | 
100 | escape: function [str] [re result match i] [
101 |     re: regexp "[\x00-\x19^^^"]" "mg"
102 |     result: ""
103 |     i: 0
104 |     while [match: apply re/exec [str]] [
105 |         result: result + apply str/substr [i match/index - i]
106 |         switch-default pick-array str match/index [
107 |             #"^^" [
108 |                 result: result + "^^^^"
109 |             ]
110 |             #"^/" [
111 |                 result: result + "^^/"
112 |             ]
113 |             #"^"" [
114 |                 result: result + "^^^""
115 |             ]
116 |             #"^-" [
117 |                 result: result + "^^-"
118 |             ]
119 |             #"^!" [
120 |                 result: result + "^^!"
121 |             ]
122 |         ] [
123 |             result: rejoin [result #"^^" to-char (apply str/char-code-at [match/index]) + 64]
124 |         ]
125 |         i: match/index + 1
126 |     ]
127 |     either i = 0 [
128 |         str
129 |     ] [
130 |         result + apply str/substr [i]
131 |     ]
132 | ]
133 | unescape: function [str] [result i j ch p] [
134 |     result: ""
135 |     i: 0
136 |     while [0 <= j: apply str/index-of [#"^^" i]] [
137 |         result: result + apply str/substr [i j - i]
138 |         ch: pick-array str j + 1
139 |         switch-default ch [
140 |             #"/" [
141 |                 result: result + #"^/"
142 |                 i: j + 2
143 |             ]
144 |             #"-" [
145 |                 result: result + #"^-"
146 |                 i: j + 2
147 |             ]
148 |             #"^^" [
149 |                 result: result + #"^^"
150 |                 i: j + 2
151 |             ]
152 |             #"!" [
153 |                 result: result + #"^!"
154 |                 i: j + 2
155 |             ]
156 |         ] [
157 |             case [
158 |                 all [ch >= #"@"  ch <= #"_"] [
159 |                     result: result + to-char (apply ch/char-code-at [0]) - 64
160 |                     i: j + 2
161 |                 ]
162 |                 all [
163 |                     ch = #"("
164 |                     p: exec-re apply str/substr [j + 1] regexp "^^\(([0-9A-Fa-f]+)\)" ""
165 |                 ] [
166 |                     result: result + to-char apply parse-int [pick-array p 1 16]
167 |                     i: j + 1 + length-of-array pick-array p 0
168 |                 ]
169 |                 'else [
170 |                     result: result + ch
171 |                     i: j + 2
172 |                 ]
173 |             ]
174 |         ]
175 |     ]
176 |     either i = 0 [
177 |         str
178 |     ] [
179 |         result + apply str/substr [i]
180 |     ]
181 | ]
182 | to-js-string: function [string] [] [
183 |     apply string/string/substr [string/pos]
184 | ]
185 | match-string?: function [string match] [] [
186 |     match = apply string/string/substr [string/pos match/length]
187 | ]
188 | 
189 | make-string: function [type string pos] [] [
190 |     make-struct [
191 |         type: type
192 |         string: string
193 |         pos: pos
194 |     ]
195 | ]
196 | 
197 | parse-string: function [text] [t] [
198 |     if #"^"" = pick text 0 [
199 |         t: exec-re to-js-string text regexp "^^^"(([^^^"^^\f\n\r]*|\^^\([0-9A-Fa-f]+\)|\^^[^^\f\n\r])*)^"" ""
200 |         either t [
201 |             reduce [
202 |                 make string! unescape pick-array t 1
203 |                 skip text length-of-array pick-array t 0
204 |             ]
205 |         ] [
206 |             error make-struct [
207 |                 category: "Syntax"
208 |                 id: "load-error"
209 |                 message: "Missing ^""
210 |                 stack: text
211 |             ]
212 |         ]
213 |     ]
214 | ]
215 | 


--------------------------------------------------------------------------------
/topaz/types/throw.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz types: THROW!"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPES: THROW! =========================================================
29 | 
30 | ; This is an internal datatype
31 | 
32 | make-internal-type 'throw! [
33 |     make: function [arguments] [] [
34 |         make-struct [
35 |             type: throw!
36 |             value: arguments
37 |         ]
38 |     ]
39 |     topaz-make: function [] [] [should-not-happen "MAKE" "THROW!"]
40 |     mold: function [] [] [should-not-happen "MOLD" "THROW!"]
41 |     do: function [] [] [should-not-happen "DO" "THROW!"]
42 |     bind: function [] [] [should-not-happen "BIND" "THROW!"]
43 |     compile: function [] [] [should-not-happen "COMPILE" "THROW!"]
44 |     equal?: :default-equal?
45 |     copy: function [value] [] [value]
46 | ]
47 | 
48 | should-not-happen: function [name type] [] [
49 |     error make-struct [
50 |         category: "Internal"
51 |         id: "should-not-happen"
52 |         message: rejoin [name " on " type " should not happen"]
53 |     ]
54 | ]
55 | 


--------------------------------------------------------------------------------
/topaz/types/typeset.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: TYPESET!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: TYPESET! =======================================================
 29 | 
 30 | make-type 'typeset! [
 31 |     make: function [args] [ts] [
 32 |         if not args [args: make-struct []]
 33 |         ts: make-struct [
 34 |             type: typeset!
 35 |             names: any [args/names make-array]
 36 |             map: any [args/map make-struct []]
 37 |         ]
 38 |         if args/types [
 39 |             foreach 'type args/types [
 40 |                 if not ts/map/(type/name) [
 41 |                     append-array ts/names type/name
 42 |                     ts/map/(type/name): true
 43 |                 ]
 44 |             ]
 45 |         ]
 46 |         ts
 47 |     ]
 48 |     topaz-make: function [types] [tps] [
 49 |         if not block? types [
 50 |             error make-struct [
 51 |                 category: "Script"
 52 |                 id: "invalid-argument"
 53 |                 message: "Invalid argument for MAKE TYPESET! (expected BLOCK!)"
 54 |                 args: types
 55 |             ]
 56 |         ]
 57 |         tps: make-array
 58 |         foreach-blk [value pos] types [
 59 |             if value/type/name = "word!" [
 60 |                 value: get value
 61 |             ]
 62 |             switch-default value/type/name [
 63 |                 "datatype!" [
 64 |                     append-array tps value
 65 |                 ]
 66 |                 "typeset!" [
 67 |                     ; hack
 68 |                     foreach 'name value/names [
 69 |                         append-array tps make-struct [name: name]
 70 |                     ]
 71 |                 ]
 72 |             ] [
 73 |                 error make-struct [
 74 |                     category: "Script"
 75 |                     id: "invalid-spec"
 76 |                     message: "Invalid spec value for TYPESET!"
 77 |                     args: value
 78 |                     stack: at-block types pos
 79 |                 ]
 80 |             ]
 81 |         ]
 82 |         apply typeset!/make [make-struct [types: tps]]
 83 |     ]
 84 |     mold: function [
 85 |         "Return a LOAD-able text representation of a value"
 86 |         ts
 87 |         options:
 88 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 89 |             flat: no [logic!] "Produce a single text line"
 90 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 91 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 92 |     ] [list] [
 93 |         list: apply ts/names/join [" "]
 94 |         limit-string either only [list] [rejoin ["make typeset! [" list "]"]] limit
 95 |     ]
 96 |     do: function [ts block] [] [
 97 |         reduce [ts skip block 1]
 98 |     ]
 99 |     bind: :default-bind
100 |     compile: function [ts block] [] [
101 |         reduce [ast-value ts skip block 1]
102 |     ]
103 |     equal?: :default-equal?
104 |     copy: function [value] [] [value]
105 |     in?: function [ts value] [] [
106 |         if not datatype? value [
107 |             error make-struct [
108 |                 category: "Script"
109 |                 id: "invalid-argument"
110 |                 message: "Invalid argument for IN? TYPESET! (expected DATATYPE!)"
111 |                 args: value
112 |             ]
113 |         ]
114 |         make logic! ts/map/(value/name)
115 |     ]
116 | ]
117 | typeset!/("typeset!"): make-struct [
118 |     equal?: function [ts1 ts2] [] [
119 |         ; TODO
120 |         false
121 |     ]
122 | ]
123 | 
124 | in-typeset?: function [ts name] [] [ts/map/:name]
125 | 


--------------------------------------------------------------------------------
/topaz/types/word.topaz:
--------------------------------------------------------------------------------
  1 | Topaz [
  2 |     Title: "Topaz types: WORD!"
  3 |     Author: "Gabriele Santilli"
  4 |     Copyright: 2011
  5 |     Type: Fake-Topaz
  6 |     ; License: {
  7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
  8 |     ;     a copy of this software and associated documentation files
  9 |     ;     (the "Software"), to deal in the Software without restriction, including
 10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
 11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
 12 |     ;     permit persons to whom the Software is furnished to do so, subject
 13 |     ;     to the following conditions:
 14 | 
 15 |     ;     The above copyright notice and this permission notice shall be included
 16 |     ;     in all copies or substantial portions of the Software.
 17 | 
 18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
 19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
 21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
 22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
 23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
 25 |     ; }
 26 | ]
 27 | 
 28 | ; ===== TYPES: WORD! ==========================================================
 29 | 
 30 | compare-words: function [word1 word2] [] [word1/word = word2/word]
 31 | 
 32 | make-type 'word! [
 33 |     make: function [arguments] [] [make-word word! arguments none]
 34 |     topaz-make: function [value] [] [topaz-make-word word! value]
 35 |     mold: function [
 36 |         "Return a LOAD-able text representation of a value"
 37 |         word
 38 |         options:
 39 |             only: no [logic!] "Don't generate outer [ ] for block! values"
 40 |             flat: no [logic!] "Produce a single text line"
 41 |             limit [number! none!] "Don't return a string longer than LIMIT characters"
 42 |             indent: "" [string!] "Add this string after each new line (ignored if flat)"
 43 |     ] [] [limit-string word/word limit]
 44 |     do: function [word block] [value] [
 45 |         value: get word
 46 |         case [
 47 |             word-active? value [
 48 |                 apply value/type/do [value block]
 49 |             ]
 50 |             'else [
 51 |                 reduce [value skip block 1]
 52 |             ]
 53 |         ]
 54 |     ]
 55 |     bind: function [
 56 |         "Bind words to a specified context"
 57 |         word
 58 |         context [context!]
 59 |         options:
 60 |             copy: no [logic!] "Bind a (deep) copy of WORDS"
 61 |             new: no [logic!] "Add all words to CONTEXT"
 62 |     ] [] [bind-word context word new]
 63 |     compile: function [word block] [value] [
 64 |         value: get/any word
 65 |         either all [
 66 |             value
 67 |             compiler-word-active? value
 68 |         ] [
 69 |             apply value/type/compile [value block]
 70 |         ] [
 71 |             reduce [ast-get word skip block 1]
 72 |         ]
 73 |     ]
 74 |     equal?: :default-equal?
 75 | ]
 76 | word!/("word!"): make-struct [
 77 |     equal?: :compare-words
 78 | ]
 79 | word!/("get-word!"): make-struct [
 80 |     equal?: :compare-words
 81 | ]
 82 | word!/("set-word!"): make-struct [
 83 |     equal?: :compare-words
 84 | ]
 85 | word!/("lit-word!"): make-struct [
 86 |     equal?: :compare-words
 87 | ]
 88 | 
 89 | make-word: function [type word args] [] [
 90 |     if not args [args: make-struct []]
 91 |     make-struct [
 92 |         type: type
 93 |         word: word
 94 |         context: args/context
 95 |         offset: args/offset
 96 |     ]
 97 | ]
 98 | 
 99 | topaz-make-word: function [type value] [] [
100 |     switch-default value/type/name [
101 |         "string!" [make-word type to-js-string value none]
102 |         "word!" [convert-word value type]
103 |         "set-word!" [convert-word value type]
104 |         "get-word!" [convert-word value type]
105 |         "lit-word!" [convert-word value type]
106 |         "datatype!" [bind-word system-words make-word type value/name none true]
107 |     ] [
108 |         error make-struct [
109 |             category: "Script"
110 |             id: "invalid-argument"
111 |             message: rejoin ["Invalid argument for MAKE " apply type/name/to-upper-case []]
112 |             args: value
113 |         ]
114 |     ]
115 | ]
116 | 
117 | convert-word: function [word type] [] [
118 |     make-word type word/word make-struct [
119 |         context: word/context
120 |         offset: word/offset
121 |     ]
122 | ]
123 | 
124 | get: function [
125 |     "Return the value of a word in its context"
126 |     word [any-word!]
127 |     options:
128 |         any: no [logic!] "If value is not set, return NONE instead of causing an error"
129 | ] [value] [
130 |     if not word/context [
131 |         error make-struct [
132 |             category: "Script"
133 |             id: "no-context"
134 |             message: "Word has no context"
135 |             args: word
136 |         ]
137 |     ]
138 |     value: pick-array word/context/values word/offset
139 |     if all [not :any not value] [
140 |         error make-struct [
141 |             category: "Script"
142 |             id: "no-value"
143 |             message: "Word has no value"
144 |             args: word
145 |         ]
146 |     ]
147 |     value
148 | ]
149 | 
150 | parse-word: function [text] [w] [
151 |     if w: parse-word-chars text [
152 |         reduce [
153 |             make word! w
154 |             skip text length-of-array w
155 |         ]
156 |     ]
157 | ]
158 | 


--------------------------------------------------------------------------------
/topaz/typesets.topaz:
--------------------------------------------------------------------------------
 1 | Topaz [
 2 |     Title: "Topaz standard typesets"
 3 |     Author: "Gabriele Santilli"
 4 |     Copyright: 2011
 5 |     Type: Fake-Topaz
 6 |     ; License: {
 7 |     ;     Permission is hereby granted, free of charge, to any person obtaining
 8 |     ;     a copy of this software and associated documentation files
 9 |     ;     (the "Software"), to deal in the Software without restriction, including
10 |     ;     without limitation the rights to use, copy, modify, merge, publish,
11 |     ;     distribute, sublicense, and/or sell copies of the Software, and to
12 |     ;     permit persons to whom the Software is furnished to do so, subject
13 |     ;     to the following conditions:
14 | 
15 |     ;     The above copyright notice and this permission notice shall be included
16 |     ;     in all copies or substantial portions of the Software.
17 | 
18 |     ;     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
19 |     ;     OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20 |     ;     FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21 |     ;     THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
22 |     ;     OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
23 |     ;     ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
24 |     ;     OTHER DEALINGS IN THE SOFTWARE.
25 |     ; }
26 | ]
27 | 
28 | ; ===== TYPESETS ==============================================================
29 | 
30 | any-word!: make typeset! make-struct [types: reduce [word! set-word! get-word! lit-word!]]
31 | any-word?: function [value] [] [in-typeset? any-word! value/type/name]
32 | any-block!: make typeset! make-struct [types: reduce [path! set-path! lit-path! block! paren!]]
33 | any-block?: function [value] [] [in-typeset? any-block! value/type/name]
34 | any-string!: make typeset! make-struct [types: reduce [string! file!]]
35 | any-string?: function [value] [] [in-typeset? any-string! value/type/name]
36 | 
37 | word-active!: make typeset! make-struct [types: reduce [function! native! action! return!]]
38 | word-active?: function [value] [] [in-typeset? word-active! value/type/name]
39 | compiler-word-active!: make typeset! make-struct [types: reduce [function! native! expression!]]
40 | compiler-word-active?: function [value] [] [in-typeset? compiler-word-active! value/type/name]
41 | insert-as-block!: make typeset! make-struct [types: reduce [block! paren!]]
42 | insert-as-block?: function [value] [] [in-typeset? insert-as-block! value/type/name]
43 | 
44 | block?: function [value] [] [value/type/name = "block!"]
45 | datatype?: function [value] [] [value/type/name = "datatype!"]
46 | set-word?: function [value] [] [value/type/name = "set-word!"]
47 | string?: function [value] [] [value/type/name = "string!"]
48 | word?: function [value] [] [value/type/name = "word!"]
49 | expression?: function [value] [] [value/type/name = "expression!"]
50 | none?: function [value] [] [value/type/name = "none!"]
51 | object?: function [value] [] [value/type/name = "object!"]
52 | context?: function [value] [] [value/type/name = "context!"]
53 | error?: function [value] [] [value/type/name = "error!"]
54 | op?: function [value] [] [value/type/name = "op!"]
55 | char?: function [value] [] [value/type/name = "char!"]
56 | number?: function [value] [] [value/type/name = "number!"]
57 | 


--------------------------------------------------------------------------------