Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Loading…

Initial rules for decimal support #700

Closed
wants to merge 8 commits into from

3 participants

@Oldes

Adding initial rules for decimal support into the lexer. With this change, decimal number is transcoded to integer.

@Oldes

current version, with the decimal/init call crashes, when I run console with error:

*** Runtime Error 1: access violation
*** in file: symbol.reds
*** at line: 27

so there must be something wrong or missing.

@dockimbel dockimbel closed this
@iArnold

David, Line 220 of the lexer, do you accept decimal numbers of the form .5e2 ?
To me it looks like you are on the right way with this, going to dive deeper into this.

@Oldes

@iArnold .5e2 was properly recognized. But as I'm not able to do int-to-float conversion, I will not move it much farther. Also my free time window is closed again as this pull request.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Mar 1, 2014
  1. @Oldes

    Adding simple decimal rule.

    Oldes authored
  2. @Oldes

    Fixed previous typos and adding initial trans-decimal routine (curren…

    Oldes authored
    …tly returning only integer)
  3. @Oldes
  4. @Oldes

    Improved decimal-rule to handle exponential notation without decimal …

    Oldes authored
    …point and prepared trans-decimal routine for real conversion once there will be decimal! in Red
  5. @Oldes
  6. @Oldes
Commits on Mar 2, 2014
  1. @Oldes
  2. @Oldes

    Renamed float! master datatype to decimal! to be compatible with the …

    Oldes authored
    …compiler writen in Rebol and adding missing initialisation.
This page is out of date. Refresh to see the latest.
View
4 boot.red
@@ -46,7 +46,7 @@ routine!: make datatype! #get-definition TYPE_ROUTINE
object!: make datatype! #get-definition TYPE_OBJECT
;port!: make datatype! #get-definition TYPE_PORT
bitset!: make datatype! #get-definition TYPE_BITSET
-;float!: make datatype! #get-definition TYPE_FLOAT
+float!: make datatype! #get-definition TYPE_FLOAT
point!: make datatype! #get-definition TYPE_POINT
none: make none! 0
@@ -1090,4 +1090,4 @@ load: function [
transcode source out
unless :all [if 1 = length? out [out: out/1]]
out
-]
+]
View
34 lexer.r
@@ -211,7 +211,33 @@ lexer: context [
] :pos
fail?
]
-
+
+ decimal-number-rule: [
+ (type: decimal!)
+ opt [#"-" | #"+"] [
+ ;for numbers like: 1.0 -1.e2 1.0e-2
+ [
+ any digit #"." some digit
+ | some digit #"." any digit
+ ]
+ opt [[#"e" | #"E"] opt [#"-" | #"+"] some digit]
+ |
+ ;for numbers like: 1e2
+ some digit
+ [#"e" | #"E"] opt [#"-" | #"+"] some digit
+ ]
+ e:
+ ]
+
+ decimal-rule: [
+ decimal-number-rule
+ pos: [ ;-- protection rule from typo with sticky words
+ [integer-end | ws-no-count | end] (fail?: none)
+ | skip (fail?: [end skip])
+ ] :pos
+ fail?
+ ]
+
block-rule: [#"[" (stack/push block!) any-value #"]" (value: stack/pop block!)]
paren-rule: [#"(" (stack/push paren!) any-value #")" (value: stack/pop paren!)]
@@ -326,6 +352,7 @@ lexer: context [
| multiline-comment-rule
| escaped-rule (stack/push value)
| integer-rule (stack/push load-integer copy/part s e)
+ | decimal-rule (stack/push load-decimal copy/part s e)
| hexa-rule (stack/push decode-hexa copy/part s e)
| word-rule (stack/push to type value)
| lit-word-rule (stack/push to type value)
@@ -485,6 +512,11 @@ lexer: context [
s
]
+ load-decimal: func [s [string!]][
+ unless attempt [s: to decimal! s][throw-error]
+ s
+ ]
+
load-string: func [s [string!] e [string!] /local new filter][
new: make string! offset? s e ;-- allocated size close to final size
filter: get pick [UTF8-char UTF8-filtered-char] s/-1 = #"{"
View
150 lexer.red
@@ -97,6 +97,134 @@ trans-hexa: routine [
n
]
+trans-decimal: routine [
+ start [string!]
+ end [string!]
+ /local
+ c [integer!]
+ value [integer!]
+ m [integer!]
+ len [integer!]
+ p [byte-ptr!]
+ neg? [logic!]
+ expon [integer!] ;should be decimal!
+ frac [logic!]
+ scale [integer!] ;should be decimal!
+ ;pow10 [deecimal!]
+][
+ str: GET_BUFFER(start)
+ unit: GET_UNIT(str)
+ p: string/rs-head start
+ len: end/head - start/head
+ neg?: no
+
+ c: string/get-char p unit
+ if any [
+ c = as-integer #"+"
+ c = as-integer #"-"
+ ][
+ neg?: c = as-integer #"-"
+ p: p + unit
+ len: len - 1
+ ]
+ value: 0
+ while [
+ c: string/get-char p unit
+ all [
+ c >= as-integer #"0"
+ c <= as-integer #"9"
+ ]
+ ][
+ m: value * 10
+ if m < value [SET_RETURN(none-value) exit] ;-- return NONE on overflow
+ value: m
+
+ m: value + c - #"0"
+ if m < value [SET_RETURN(none-value) exit] ;-- return NONE on overflow
+ value: m
+
+ p: p + unit
+ len: len - 1
+ ]
+
+ ;Handle numbers after decimal point if there are any
+ if c = as-integer #"." [
+ p: p + unit
+ len: len - 1
+ while [
+ c: string/get-char p unit
+ all [
+ c >= as-integer #"0"
+ c <= as-integer #"9"
+ ]
+ ][
+ ;DO NOTHING SO FAR AS I CANNOT DIVIDE PROPERLY YET
+ ;pow10: 10.0
+ ;value: value + (c - #"0") / pow10
+ ;pow10: pow10 * 10.0
+ p: p + unit
+ len: len - 1
+ ]
+ ]
+
+ frac: no
+ scale: 1 ;should be 1.0!
+
+ if all [
+ len > 0
+ any [
+ c = as-integer #"e"
+ c = as-integer #"E"
+ ]
+ ][
+ expon: 0
+ p: p + unit
+ len: len - 1
+
+ c: string/get-char p unit
+ if any [
+ c = as-integer #"+"
+ c = as-integer #"-"
+ ][
+ frac: c = as-integer #"-"
+ p: p + unit
+ len: len - 1
+ ]
+ until [
+ c: string/get-char p unit
+
+ m: expon * 10 ;should be 10.0
+ if m < expon [SET_RETURN(none-value) exit] ;-- return NONE on overflow
+ expon: m
+
+ m: expon + c - #"0"
+ if m < expon [SET_RETURN(none-value) exit] ;-- return NONE on overflow
+ expon: m
+
+ p: p + unit
+ len: len - 1
+ zero? len
+ ]
+ ;while [expon >= 50] [
+ ; scale: scale * 1E50
+ ; expon: expon - 50
+ ;]
+ while [expon >= 8] [
+ scale: scale * 100000000 ;1E8
+ expon: expon - 8
+ ]
+ while [expon > 0] [
+ scale: scale * 10 ;10.0
+ expon: expon - 1
+ ]
+ value: either frac [
+ value / scale
+ ][ value * scale ]
+ ]
+
+ integer/box either neg? [0 - value][value]
+]
+
trans-push-path: routine [
stack [block!]
type [datatype!]
@@ -387,6 +515,27 @@ transcode: func [
ahead [integer-end | ws-no-count | end]
]
+ decimal-number-rule: [
+ opt [#"-" | #"+"] [
+ ;for numbers like: 1.0 -1.e2 1.0e-2
+ [
+ any digit #"." some digit
+ | some digit #"." any digit
+ ]
+ opt [[#"e" | #"E"] opt [#"-" | #"+"] some digit]
+ |
+ ;for numbers like: 1e2
+ some digit
+ [#"e" | #"E"] opt [#"-" | #"+"] some digit
+ ]
+ e:
+ ]
+
+ decimal-rule: [
+ decimal-number-rule
+ ahead [integer-end | ws-no-count | end]
+ ]
+
block-rule: [
#"[" (append/only stack make block! 4)
any-value
@@ -456,6 +605,7 @@ transcode: func [
| multiline-comment-rule
| escaped-rule (append last stack value)
| integer-rule (append last stack trans-integer s e)
+ | decimal-rule (append last stack trans-decimal s e)
| hexa-rule (append last stack trans-hexa s e)
| word-rule
| lit-word-rule
View
355 runtime/datatypes/decimal.reds
@@ -0,0 +1,355 @@
+Red/System [
+ Title: "Float! datatype runtime functions"
+ Author: "Nenad Rakocevic, Oldes"
+ File: %decimal.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
+ }
+]
+
+decimal: context [
+ verbose: 0
+
+ get*: func [ ;-- unboxing float value from stack
+ return: [float!]
+ /local
+ fl [red-float!]
+ ][
+ fl: as red-float! stack/arguments
+ assert TYPE_OF(fl) = TYPE_FLOAT
+ fl/value
+ ]
+
+ get-any*: func [ ;-- special get* variant for SWITCH
+ return: [float!]
+ /local
+ fl [red-float!]
+ ][
+ fl: as red-float! stack/arguments
+ either TYPE_OF(fl) = TYPE_FLOAT [fl/value][0.0] ;-- accept NONE values
+ ]
+
+ get: func [ ;-- unboxing float value
+ value [red-value!]
+ return: [float!]
+ /local
+ fl [red-float!]
+ ][
+ assert TYPE_OF(value) = TYPE_FLOAT
+ fl: as red-float! value
+ fl/value
+ ]
+
+ box: func [
+ value [float!]
+ return: [red-float!]
+ /local
+ int [red-float!]
+ ][
+ fl: as red-float! stack/arguments
+ fl/header: TYPE_FLOAT
+ fl/value: value
+ fl
+ ]
+
+; form-signed: func [ ;@@ replace with sprintf() call?
+; i [integer!]
+; return: [c-string!]
+; /local
+; s [c-string!]
+; c [integer!]
+; n [logic!]
+; ][
+; s: "-0000000000" ;-- 11 bytes wide
+; if zero? i [ ;-- zero special case
+; s/11: #"0"
+; return s + 10
+; ]
+; if i = -2147483648 [ ;-- min integer special case
+; return "-2147483648"
+; ]
+; n: negative? i
+; if n [i: negate i]
+; c: 11
+; while [i <> 0][
+; s/c: #"0" + (i // 10)
+; i: i / 10
+; c: c - 1
+; ]
+; if n [s/c: #"-" c: c - 1]
+; s + c
+; ]
+
+ do-math: func [
+ type [integer!]
+ return: [red-float!]
+ /local
+ args [red-value!]
+ left [red-float!]
+ right [red-float!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "float/do-math"]]
+
+ args: stack/arguments
+ left: as red-float! args
+ right: as red-float! args + 1
+
+ assert TYPE_OF(left) = TYPE_FLOAT
+ assert TYPE_OF(right) = TYPE_FLOAT
+
+ left/value: switch type [
+ OP_ADD [left/value + right/value]
+ OP_SUB [left/value - right/value]
+ OP_MUL [left/value * right/value]
+ OP_DIV [left/value / right/value]
+ ]
+ left
+ ]
+
+ load-in: func [
+ blk [red-block!]
+ value [float!]
+ /local
+ fl [red-float!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "float/load-in"]]
+
+ fl: as red-float! ALLOC_TAIL(blk)
+ fl/header: TYPE_FLOAT
+ fl/value: value
+ ]
+
+ push: func [
+ value [float!]
+ return: [red-float!]
+ /local
+ fl [red-float!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "float/push"]]
+
+ fl: as red-float! stack/push*
+ fl/header: TYPE_FLOAT
+ fl/value: value
+ fl
+ ]
+
+ ;-- Actions --
+
+ make: func [
+ proto [red-value!]
+ spec [red-value!]
+ return: [red-float!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "float/make"]]
+
+ switch TYPE_OF(spec) [
+ TYPE_FLOAT [
+ as red-float! spec
+ ]
+ default [
+ --NOT_IMPLEMENTED--
+ as red-float! spec ;@@ just for making it compilable
+ ]
+ ]
+ ]
+
+ form: func [
+ fl [red-float!]
+ buffer [red-string!]
+ arg [red-value!]
+ part [integer!]
+ return: [integer!]
+ /local
+ formed [c-string!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "float/form"]]
+
+ formed: "" ;form-signed fl/value
+ string/concatenate-literal buffer formed
+ part - length? formed ;@@ optimize by removing length?
+ ]
+
+ mold: func [
+ fl [red-float!]
+ 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 "float/mold"]]
+
+ form fl buffer arg part
+ ]
+
+ compare: func [
+ value1 [red-float!] ;-- first operand
+ value2 [red-float!] ;-- second operand
+ op [integer!] ;-- type of comparison
+ return: [logic!]
+ /local
+ char [red-char!]
+ left [float!]
+ right [float!]
+ res [logic!]
+ ][
+ #if debug? = yes [if verbose > 0 [print-line "float/compare"]]
+
+ left: value1/value
+
+ switch TYPE_OF(value2) [
+ TYPE_FLOAT [
+ right: value2/value
+ ]
+ default [RETURN_COMPARE_OTHER]
+ ]
+ switch op [
+ COMP_EQUAL [res: left = right]
+ COMP_NOT_EQUAL [res: left <> right]
+ COMP_STRICT_EQUAL [res: all [TYPE_OF(value2) = TYPE_FLOAT left = right]]
+ COMP_LESSER [res: left < right]
+ COMP_LESSER_EQUAL [res: left <= right]
+ COMP_GREATER [res: left > right]
+ COMP_GREATER_EQUAL [res: left >= right]
+ ]
+ res
+ ]
+
+ complement: func [
+ fl [red-float!]
+ return: [red-value!]
+ ][
+ --NOT_IMPLEMENTED--
+ ;fl/value: not fl/value
+ as red-value! fl
+ ]
+
+ add: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "float/add"]]
+ as red-value! do-math OP_ADD
+ ]
+
+ divide: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "float/divide"]]
+ as red-value! do-math OP_DIV
+ ]
+
+ multiply: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "float/multiply"]]
+ as red-value! do-math OP_MUL
+ ]
+
+ subtract: func [return: [red-value!]][
+ #if debug? = yes [if verbose > 0 [print-line "float/subtract"]]
+ as red-value! do-math OP_SUB
+ ]
+
+ negate: func [
+ return: [red-float!]
+ /local
+ fl [red-float!]
+ ][
+ fl: as red-float! stack/arguments
+ fl/value: 0.0 - fl/value
+ fl ;-- re-use argument slot for return value
+ ]
+
+ even?: func [
+ int [red-float!]
+ return: [logic!]
+ ][
+ ;requires conversion to integer
+ ;not as-logic float/value and 1
+ --NOT_IMPLEMENTED--
+ false
+ ]
+
+ odd?: func [
+ int [red-integer!]
+ return: [logic!]
+ ][
+ ;requires conversion to integer
+ ;as-logic int/value and 1
+ --NOT_IMPLEMENTED--
+ false
+ ]
+
+ init: does [
+ datatype/register [
+ TYPE_FLOAT
+ TYPE_VALUE
+ "float!"
+ ;-- General actions --
+ :make
+ null ;random
+ null ;reflect
+ null ;to
+ :form
+ :mold
+ null ;get-path
+ null ;set-path
+ :compare
+ ;-- Scalar actions --
+ null ;absolute
+ :add
+ :divide
+ :multiply
+ :negate
+ null ;power
+ null ;remainder
+ null ;round
+ :subtract
+ :even?
+ :odd?
+ ;-- Bitwise actions --
+ null ;and~
+ :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
6 runtime/datatypes/structures.reds
@@ -135,6 +135,12 @@ red-integer!: alias struct! [
_pad [integer!]
]
+red-float!: alias struct! [
+ header [integer!] ;-- cell header
+ padding [integer!]
+ value [float!] ;-- 64-bit float value
+]
+
red-context!: alias struct! [
header [integer!] ;-- cell header
symbols [node!] ;-- array of symbols ID
View
3  runtime/red.reds
@@ -63,6 +63,7 @@ red: context [
#include %datatypes/object.reds
#include %datatypes/bitset.reds
#include %datatypes/point.reds
+ #include %datatypes/decimal.reds
;-- Debugging helpers --
@@ -99,6 +100,7 @@ red: context [
block/init
string/init
integer/init
+ decimal/init
symbol/init
_context/init
word/init
@@ -150,6 +152,7 @@ red: context [
block/verbose: verbosity
string/verbose: verbosity
integer/verbose: verbosity
+ decimal/verbose: verbosity
symbol/verbose: verbosity
_context/verbose: verbosity
word/verbose: verbosity
View
2  system/compiler.r
@@ -515,7 +515,7 @@ system-dialect: make-profilable context [
resolve-path-type: func [path [path! set-path!] /short /parent prev /local type path-error saved][
path-error: [
pc: skip pc -2
- throw-error "invalid path value"
+ throw-error ["invalid path value:" path]
]
either word? path/1 [
either parent [
Something went wrong with that request. Please try again.