Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

Avhtuple to android branch #663

Closed
wants to merge 8 commits into from

2 participants

@iArnold

I noticed my pull request was against the master instead of the android.
Another try.

I created a branch of the android branch because that has pair support in it. I worked my way through the changes and copied the inserted lines for the pair support into the basics to support tuple! and save you the time of doing this.

Not tested, and there still is a lot left to do in tuple.reds and the logic in the lexer.r file. ( I did not figure out what the opt [ ] does)

Hope you will accept this start and I hope it did save you a little time.

iArnold added some commits
@iArnold iArnold Preliminary support for tuple! Update boot.red
Already started some trivial coding for tuple! support so that Superman doesn't have to spend his time on this.
7d78ea5
@iArnold iArnold Tuple support. Update lexer.r
"Look at this"
84d8458
@iArnold iArnold Update common.reds
Added z next to the x and y for pair! for tuple! support
9587076
@iArnold iArnold Update structures.reds
Added tuple! structure
b265e73
@iArnold iArnold Update macros.reds
Added TYPE_TUPLE
364ed71
@iArnold iArnold Update red.reds
Added tuple next to pair
ce40938
@iArnold iArnold Create tuple.reds
New file. Direct copy of pair.reds
Added myself as author and changed all occurrences of the word pair to tuple.
Needs some work on red-tuple! type.
b2e777a
@iArnold iArnold Update tuple.reds
some minor additions for the 3rd part of the tuple
9af87f5
@dockimbel
Owner

Thanks for the try at implementing a new datatype, but there are many issues in your code:

  • Code is untested, that is already enough for me to not accept a PR. If you want to save me time, the least you can do is ensure that the provided code works...:-/

  • The memory model used by your tuple! is wrong (hence most of the code in %tuple.reds is wrong too). Tuple! are using bytes not integers.

  • You lack some understanding of the Red internal core features, like the fixed slot size for values which is 128-bit. Your red-tuple! definition uses 160 bits...

  • Minor issues, but still annoying: you need to respect the whitespaces usage in Red codebase. Your code editor is adding an extra line at the end of all the modified Red files... Also in %lexer.r, the following code is oddly lacking separating whitespaces: |"pair!"|"tuple!"...

Sorry, I can't accept your PR for tuple! in such form...

PS: typing code is the less time-consuming task for me. Implementing the right features and debugging them eat the most of my coding time.

@dockimbel dockimbel closed this
@dockimbel dockimbel referenced this pull request
Closed

Xtratuple1 #665

@iArnold iArnold deleted the branch
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Jan 20, 2014
  1. @iArnold

    Preliminary support for tuple! Update boot.red

    iArnold authored
    Already started some trivial coding for tuple! support so that Superman doesn't have to spend his time on this.
  2. @iArnold

    Tuple support. Update lexer.r

    iArnold authored
    "Look at this"
  3. @iArnold

    Update common.reds

    iArnold authored
    Added z next to the x and y for pair! for tuple! support
  4. @iArnold

    Update structures.reds

    iArnold authored
    Added tuple! structure
  5. @iArnold

    Update macros.reds

    iArnold authored
    Added TYPE_TUPLE
  6. @iArnold

    Update red.reds

    iArnold authored
    Added tuple next to pair
  7. @iArnold

    Create tuple.reds

    iArnold authored
    New file. Direct copy of pair.reds
    Added myself as author and changed all occurrences of the word pair to tuple.
    Needs some work on red-tuple! type.
  8. @iArnold

    Update tuple.reds

    iArnold authored
    some minor additions for the 3rd part of the tuple
This page is out of date. Refresh to see the latest.
View
4 boot.red
@@ -49,6 +49,7 @@ bitset!: make datatype! #get-definition TYPE_BITSET
float!: make datatype! #get-definition TYPE_FLOAT
point!: make datatype! #get-definition TYPE_POINT
pair!: make datatype! #get-definition TYPE_PAIR
+tuple!: make datatype! #get-definition TYPE_TUPLE
none: make none! 0
true: make logic! 1
@@ -929,6 +930,7 @@ refinement?: func ["Returns true if the value is this type." value [any-type!]]
set-path?: func ["Returns true if the value is this type." value [any-type!]] [set-path! = type? :value]
set-word?: func ["Returns true if the value is this type." value [any-type!]] [set-word! = type? :value]
string?: func ["Returns true if the value is this type." value [any-type!]] [string! = type? :value]
+tuple?: func ["Returns true if the value is this type." value [any-type!]] [tuple! = type? :value]
unset?: func ["Returns true if the value is this type." value [any-type!]] [unset! = type? :value]
word?: func ["Returns true if the value is this type." value [any-type!]] [word! = type? :value]
@@ -1077,4 +1079,4 @@ parse-trace: func [
return: [logic! block!]
][
parse/trace input rules :on-parse-event
-]
+]
View
14 lexer.r
@@ -19,6 +19,7 @@ lexer: context [
e: none ;-- mark end position of new value
value: none ;-- new value
value2: none ;-- secondary new value
+ value3: none ;-- tertiary new value
fail?: none ;-- used for failing some parsing rules
type: none ;-- define the type of the new value
@@ -61,7 +62,7 @@ lexer: context [
not-mstr-char: #"}"
caret-char: charset [#"^(40)" - #"^(5F)"]
non-printable-char: charset [#"^(00)" - #"^(1F)"]
- integer-end: charset {^{"]);x}
+ integer-end: charset {^{"]);x.}
stop: none
control-char: reduce [
@@ -216,8 +217,15 @@ lexer: context [
type: pair!
value2: to pair! reduce [value 0]
)
+;Look at this
+; #"." (
+; type: tuple!
+; value2: to tuple! reduce [value 0]
+; value3: to tuple! reduce [value 0]
+; )
s: integer-rule
(value2/2: load-integer copy/part s e value: value2)
+; (value3/3: load-integer copy/part s e value: value3)
]
]
@@ -306,7 +314,7 @@ lexer: context [
| "set-word!" | "get-word!" | "lit-word!" | "refinement!"
| "binary!" | "string!" | "char!" | "bitset!" | "path!"
| "set-path!" | "lit-path!" | "native!" | "action!"
- | "issue!" | "paren!" | "function!"
+ | "issue!" | "paren!" | "function!"|"pair!"|"tuple!"
] e: (value: get to word! copy/part s e)
] any-ws #"]"
]
@@ -528,4 +536,4 @@ lexer: context [
stack/reset
blk
]
-]
+]
View
4 runtime/datatypes/common.reds
@@ -128,6 +128,7 @@ words: context [
ahead: -1
x: -1
y: -1
+ z: -1
_body: as red-word! 0
_windows: as red-word! 0
@@ -197,6 +198,7 @@ words: context [
x: symbol/make "x"
y: symbol/make "y"
+ z: symbol/make "z"
_body: _context/add-global body
_windows: _context/add-global windows
@@ -224,4 +226,4 @@ refinements: context [
local: refinement/load "local"
extern: refinement/load "extern"
]
-]
+]
View
8 runtime/datatypes/structures.reds
@@ -184,6 +184,14 @@ red-pair!: alias struct! [
y [integer!] ;-- 32-bit signed integer or float32!
]
+red-tuple!: alias struct! [
+ header [integer!] ;-- cell header
+ padding [integer!] ;-- align value on 64-bit boundary
+ x [integer!] ;-- 32-bit signed integer or float32!
+ y [integer!] ;-- 32-bit signed integer or float32!
+ z [integer!] ;-- 32-bit signed integer or float32!
+]
+
red-action!: alias struct! [
header [integer!] ;-- cell header
symbols [node!] ;-- action cleaned-up spec block reference
View
321 runtime/datatypes/tuple.reds
@@ -0,0 +1,321 @@
+Red/System [
+ Title: "Tuple! datatype runtime functions"
+ Author: "Nenad Rakocevic, Arnold van Hofwegen"
+ File: %tuple.reds
+ Tabs: 4
+ Rights: "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
+ License: {
+ Distributed under the Boost Software License, Version 1.0.
+ See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
+ }
+]
+
+tuple: context [
+ verbose: 0
+
+ do-math: func [
+ type [integer!]
+ return: [red-tuple!]
+ /local
+ left [red-tuple!]
+ right [red-tuple!]
+ int [red-integer!]
+ x [integer!]
+ y [integer!]
+ z [integer!]
+ ][
+ left: as red-tuple! stack/arguments
+ right: left + 1
+
+ assert TYPE_OF(left) = TYPE_TUPLE
+ assert any [
+ TYPE_OF(right) = TYPE_TUPLE
+ TYPE_OF(right) = TYPE_INTEGER
+ ]
+
+ switch TYPE_OF(right) [
+ TYPE_TUPLE [
+ x: right/x
+ y: right/y
+ z: right/z
+ ]
+ TYPE_INTEGER [
+ int: as red-integer! right
+ x: int/value
+ y: x
+ ]
+ default [
+ print-line "*** Math Error: unsupported right operand for tuple operation"
+ ]
+ ]
+
+ switch type [
+ OP_ADD [left/x: left/x + x left/y: left/y + y left/z: left/z + z]
+ OP_SUB [left/x: left/x - x left/y: left/y - y left/z: left/z - z]
+ OP_MUL [left/x: left/x * x left/y: left/y * y left/z: left/z * z]
+ OP_DIV [left/x: left/x / x left/y: left/y / y left/z: left/z / z]
+ ]
+ left
+ ]
+
+ load-in: func [
+ blk [red-block!]
+ x [integer!]
+ y [integer!]
+ z [integer!]
+ /local
+ tuple [red-tuple!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/load-in"]]
+
+ tuple: as red-tuple! ALLOC_TAIL(blk)
+ tuple/header: TYPE_TUPLE
+ tuple/x: x
+ tuple/y: y
+ tuple/z: z
+ ]
+
+ push: func [
+ value [integer!]
+ value2 [integer!]
+ value3 [integer!]
+ return: [red-tuple!]
+ /local
+ tuple [red-tuple!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/push"]]
+
+ tuple: as red-tuple! stack/push*
+ tuple/header: TYPE_TUPLE
+ tuple/x: value
+ tuple/y: value2
+ tuple/z: value3
+ tuple
+ ]
+
+ ;-- Actions --
+
+ make: func [
+ proto [red-value!]
+ spec [red-value!]
+ return: [red-integer!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/make"]]
+
+ switch TYPE_OF(spec) [
+ TYPE_INTEGER [
+ as red-integer! spec
+ ]
+ default [
+ --NOT_IMPLEMENTED--
+ as red-integer! spec ;@@ just for making it compilable
+ ]
+ ]
+ ]
+
+ form: func [
+ tuple [red-tuple!]
+ buffer [red-string!]
+ arg [red-value!]
+ part [integer!]
+ return: [integer!]
+ /local
+ formed [c-string!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/form"]]
+
+ formed: integer/form-signed tuple/x
+ string/concatenate-literal buffer formed
+ part: part - length? formed ;@@ optimize by removing length?
+
+ string/append-char GET_BUFFER(buffer) as-integer #"."
+
+ formed: integer/form-signed tuple/y
+ string/concatenate-literal buffer formed
+ string/append-char GET_BUFFER(buffer) as-integer #"."
+
+ formed: integer/form-signed tuple/z
+ string/concatenate-literal buffer formed
+ part - 2 - length? formed ;@@ optimize by removing length?
+ ]
+
+ mold: func [
+ tuple [red-tuple!]
+ buffer [red-string!]
+ only? [logic!]
+ all? [logic!]
+ flat? [logic!]
+ arg [red-value!]
+ part [integer!]
+ indent [integer!]
+ return: [integer!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/mold"]]
+
+ form tuple buffer arg part
+ ]
+
+ eval-path: func [
+ parent [red-tuple!] ;-- implicit type casting
+ element [red-value!]
+ set? [logic!]
+ return: [red-value!]
+ /local
+ int [red-integer!]
+ w [red-word!]
+ value [integer!]
+ ][
+ switch TYPE_OF(element) [
+ TYPE_INTEGER [
+ int: as red-integer! element
+ value: int/value
+ if all [value <> 1 value <> 2][
+ print-line ["*** Path Error: tuple! does not support accessor:" value]
+ ]
+ ]
+ TYPE_WORD [
+ w: as red-word! element
+ value: symbol/resolve w/symbol
+ if all [value <> words/x value <> words/y value <> words/z][
+ print-line "*** Path Error: tuple! does not support accessor:"
+ ]
+ value: either value = words/x [1][2]
+ ]
+ default [
+ print-line "*** Path Error: unsupported tuple! access path"
+ ]
+ ]
+ either set? [
+ int: as red-integer! stack/push*
+ either value = 1 [parent/x: int/value][parent/y: int/value]
+ as red-value! int
+ ][
+ integer/push either value = 1 [parent/x][parent/y]
+ ]
+ ]
+
+ compare: func [
+ left [red-tuple!] ;-- first operand
+ right [red-tuple!] ;-- second operand
+ op [integer!] ;-- type of comparison
+ return: [logic!]
+ /local
+ res [logic!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/compare"]]
+
+ switch op [
+ COMP_EQUAL [res: all [left/x = right/x left/y = right/y left/z = right/z]]
+ COMP_NOT_EQUAL [res: any [left/x <> right/x left/y <> right/y left/z <> right/z]]
+ COMP_STRICT_EQUAL [res: all [left/x = right/x left/y = right/y left/z = right/z]]
+ COMP_LESSER [res: all [left/x < right/x left/y < right/y left/z < right/z]]
+ COMP_LESSER_EQUAL [res: all [left/x <= right/x left/y <= right/y left/z <= right/z]]
+ COMP_GREATER [res: all [left/x > right/x left/y > right/y left/z > right/z]]
+ COMP_GREATER_EQUAL [res: all [left/x >= right/x left/y >= right/y left/z >= right/z]]
+ ]
+ res
+ ]
+
+ add: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/add"]]
+ as red-value! do-math OP_ADD
+ ]
+
+ divide: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/divide"]]
+ as red-value! do-math OP_DIV
+ ]
+
+ multiply: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/multiply"]]
+ as red-value! do-math OP_MUL
+ ]
+
+ subtract: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "tuple/subtract"]]
+ as red-value! do-math OP_SUB
+ ]
+
+ negate: func [
+ return: [red-integer!]
+ /local
+ int [red-integer!]
+ ][
+ int: as red-integer! stack/arguments
+ int/value: 0 - int/value
+ int ;-- re-use argument slot for return value
+ ]
+
+ init: does [
+ datatype/register [
+ TYPE_TUPLE
+ TYPE_VALUE
+ "tuple!"
+ ;-- General actions --
+ :make
+ null ;random
+ null ;reflect
+ null ;to
+ :form
+ :mold
+ :eval-path
+ null ;set-path
+ :compare
+ ;-- Scalar actions --
+ null ;absolute
+ :add
+ :divide
+ :multiply
+ :negate
+ null ;power
+ null ;remainder
+ null ;round
+ :subtract
+ null ;even?
+ null ;odd?
+ ;-- Bitwise actions --
+ null ;and~
+ null ;complement
+ null ;or~
+ null ;xor~
+ ;-- Series actions --
+ null ;append
+ null ;at
+ null ;back
+ null ;change
+ null ;clear
+ null ;copy
+ null ;find
+ null ;head
+ null ;head?
+ null ;index?
+ null ;insert
+ null ;length?
+ null ;next
+ null ;pick
+ null ;poke
+ null ;remove
+ null ;reverse
+ null ;select
+ null ;sort
+ null ;skip
+ null ;swap
+ null ;tail
+ null ;tail?
+ null ;take
+ null ;trim
+ ;-- I/O actions --
+ null ;create
+ null ;close
+ null ;delete
+ null ;modify
+ null ;open
+ null ;open?
+ null ;query
+ null ;read
+ null ;rename
+ null ;update
+ null ;write
+ ]
+ ]
+]
View
1  runtime/macros.reds
@@ -43,6 +43,7 @@ Red/System [
TYPE_POINT
TYPE_OBJECT
TYPE_PAIR
+ TYPE_TUPLE
TYPE_BINARY
View
5 runtime/red.reds
@@ -64,6 +64,7 @@ red: context [
#include %datatypes/bitset.reds
#include %datatypes/point.reds
#include %datatypes/pair.reds
+ #include %datatypes/tuple.reds
;-- Debugging helpers --
@@ -125,6 +126,7 @@ red: context [
bitset/init
point/init
pair/init
+ tuple/init
actions/init
@@ -172,6 +174,7 @@ red: context [
bitset/verbose: verbosity
point/verbose: verbosity
pair/verbose: verbosity
+ tuple/verbose: verbosity
actions/verbose: verbosity
natives/verbose: verbosity
@@ -181,4 +184,4 @@ red: context [
unicode/verbose: verbosity
]
]
-]
+]
Something went wrong with that request. Please try again.