countAlongTheWay seems to count

countAlongTheWay seems to count

import "../src/LangPrelude.prg"

data Mark = FullStop | Stop | Digit Bool

data Way = Arrived | Step Mark Way deriving List(w)

etalon = "1s100000s11010s10100s1111s1010s110s11s1S"

w1 = [FullStop]w
w2 = [Digit True, FullStop]w
w3 = [Stop, Digit True, FullStop]w

countSteps (way@[_;_]w) = howmanysteps 0 way

howmanysteps :: Int -> Way -> Int
howmanysteps 0 []w = 0
howmanysteps corr [FullStop]w = corr + 1
howmanysteps corr [Stop, Digit True; way]w = pickupMarks (trace ("corr: "++show corr) corr + 2) way 1
  where pickupMarks corr [FullStop]w acc = corr + acc
        pickupMarks corr [Stop; _]w acc = trace (show corr) corr + acc
        pickupMarks corr [Digit False; more]w acc = pickupMarks (corr + 1) more $ acc + acc
        pickupMarks corr [Digit True; more]w acc = pickupMarks (corr + 1) more $ acc + acc + 1
howmanysteps corr [Digit _; more]w = howmanysteps (corr + 1) more

l2w = foldr (Step . c2m) Arrived
  where c2m 'S' = FullStop
        c2m 's' = Stop
        c2m '0' = Digit False
        c2m '1' = Digit True

foldw :: (Mark -> b -> b) -> b -> Way -> b
foldw _ b []w = b
foldw f b [m; ms]w = f m $ foldw f b ms

w2l = foldw ((:) . m2c) []
  where m2c FullStop = 'S'
        m2c Stop = 's'
        m2c (Digit False) = '0'
        m2c (Digit True) = '1'

etalon' = l2w etalon

countAlongTheWay = foldw tupled (0,[(0,[]w)])
  where tupled m (c, l@[(_,w);_]) = (countSteps [m;w]w, (countSteps [m;w]w,[m;w]w) : l)

import "../src/LangPrelude.prg"

data Mark = FullStop | Stop | Digit Bool

data Way = Arrived | Step Mark Way deriving List(w)

etalon = "1s100000s11010s10100s1111s1010s110s11s1S"

w1 = [FullStop]w
w2 = [Digit True, FullStop]w
w3 = [Stop, Digit True, FullStop]w

countSteps (way@[_;_]w) = howmanysteps 0 way

howmanysteps :: Int -> Way -> Int
howmanysteps 0 []w = 0
howmanysteps corr [FullStop]w = corr + 1
howmanysteps corr [Stop, Digit True; way]w = pickupMarks (trace ("corr: "++show corr) corr + 2) way 1
  where pickupMarks corr [FullStop]w acc = corr + acc
        pickupMarks corr [Stop; _]w acc = trace (show corr) corr + acc
        pickupMarks corr [Digit False; more]w acc = pickupMarks (corr + 1) more $ acc + acc
        pickupMarks corr [Digit True; more]w acc = pickupMarks (corr + 1) more $ acc + acc + 1
howmanysteps corr [Digit _; more]w = howmanysteps (corr + 1) more

l2w = foldr (Step . c2m) Arrived
  where c2m 'S' = FullStop
        c2m 's' = Stop
        c2m '0' = Digit False
        c2m '1' = Digit True

foldw :: (Mark -> b -> b) -> b -> Way -> b
foldw _ b []w = b
foldw f b [m; ms]w = f m $ foldw f b ms

w2l = foldw ((:) . m2c) []
  where m2c FullStop = 'S'
        m2c Stop = 's'
        m2c (Digit False) = '0'
        m2c (Digit True) = '1'

etalon' = l2w etalon

countAlongTheWay = foldw tupled (0,[[]w])
  where tupled FullStop (0,[[]w]) = (1,[[FullStop]w, []w])
        tupled m (_, l@[w;_]) = (countSteps [m;w]w, [m;w]w : l)


t1 is rightfully rejected

t1 is rightfully rejected

data Dir :: *2 where
  Hor :: name ~> Dir -- these are nodes
  Ver :: name ~> Dir -- can be a tree of names!

data Tree :: Dir ~> *1 where
  Pri :: Tag ~> Tree (Hor Tag)
  Unit :: Tree (Ver name)
  Empty :: Tree (Hor (Wrap name))
  Paste :: Tree (Hor name) ~> Tree (Hor (Wrap name)) ~> Tree (Hor (Wrap name))
 deriving syntax (tr) List(Empty, Paste)
                      Unit(Unit)
                      Item(Pri)

data Tree' :: Tree d ~> * where
  Labeled :: Label tag -> Tree' (tag)tr
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork)
                      Unit(In)
                      Item(Labeled)

kind Wrap a = W a

{-
data Stack :: Tree (d n) ~> Tree (e n) ~> * where   -- Omega bug (occurs check)
-}
data Stack :: Tree (d n) ~> Tree e ~> * where
  Cell :: Stack ()tr ()tr
  NicheDone :: Stack ()tr []tr
  Also :: Tree' at -> Stack tr out' -> Stack tr out -> Stack tr [out'; out]tr
--Also :: Tree' out' -> Tree' out' -> Stack tr out -> Stack tr [out'; out]tr
 deriving syntax(z) Record(NicheDone, Also)

##test "Cell does not qualify"
  t1 = {(`hey)ar=Cell}z

data Dir :: *2 where
  Hor :: name ~> Dir -- these are nodes
  Ver :: name ~> Dir -- can be a tree of names!

data Tree :: Dir ~> *1 where
  Pri :: Tag ~> Tree (Hor Tag)
  Unit :: Tree (Ver name)
  Empty :: Tree (Hor (Wrap name))
  Paste :: Tree (Hor name) ~> Tree (Hor (Wrap name)) ~> Tree (Hor (Wrap name))
 deriving syntax (tr) List(Empty, Paste)
                      Unit(Unit)
                      Item(Pri)

data Tree' :: Tree d ~> * where
  Labeled :: Label tag -> Tree' (tag)tr
  In :: Tree' ()tr
  Fork :: Tree' head -> Tree' tail -> Tree' [head; tail]tr
  Done :: Tree' []tr
 deriving syntax (ar) List(Done, Fork)
                      Unit(In)
                      Item(Labeled)

kind Wrap a = W a

data Stack :: Tree (d n) ~> Tree (e n) ~> * where
  Cell :: Stack ()tr ()tr
  NicheDone :: Stack ()tr []tr
--Also :: Tree' at -> Stack tr out' -> Stack tr out -> Stack tr [out'; out]tr
  Also :: Tree' out' -> Tree' out' -> Stack tr out -> Stack tr [out'; out]tr
 deriving syntax(z) Record(NicheDone, Also)

--t1 = {(`hey)ar=Cell}z


[Runtime] Updated documentation comments for Binary type

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Text
USING System.Runtime.InteropServices
USING System.Runtime.CompilerServices
USING System.Diagnostics

BEGIN NAMESPACE XSharp
    // use explicit layout so we can compact the size into 12 bytes
    // Type is Immutable, so has no settable properties
    /// <summary>Internal type that implements the FoxPro Compatible BINARY type.
    /// This type has many operators and implicit converters that normally are never directly called from user code.
    /// The data in this type is stored as an array of Bytes
    /// Conversion To String are supported and they use the current active windows codepage.
    /// </summary>
    PUBLIC STRUCTURE __Binary IMPLEMENTS IFormattable, ;
        IComparable<__Binary>, ;
        IEquatable<__Binary>, ;
        IComparable

        PRIVATE INITONLY _value AS BYTE[]

        #region constructors
        /// <include file="RTComments.xml" path="Comments/Constructor/*" />
        /// <param name="b">Byte[] value that has the bytes that define the binary</param>
        [DebuggerStepThroughAttribute] [MethodImpl(MethodImplOptions.AggressiveInlining)];
        CONSTRUCTOR (b as Byte[])
            IF b == NULL
                VAR err			 := Error{ArgumentException{}}
                err:Gencode		 := Gencode.EG_ARG
                err:ArgNum		 := 1
                err:FuncSym		 := "Binary.ctor"
                err:Description  := "Argument cannot be null"
                err:Args         := <OBJECT> {b}
                THROW err
            ENDIF
            SELF:_value    := b

        #endregion
        #region Properties
        /// <summary>REAL8 (System.Double) value</summary>
        PROPERTY @@Value    AS Byte[]	GET _value
        PROPERTY Length as LONG GET @@Value:Length
        #endregion

        #region Equality Operators
        /// <inheritdoc />
        OVERRIDE METHOD Equals(rhs AS OBJECT  ) AS LOGIC
            LOCAL result AS LOGIC
            IF rhs != NULL .AND. rhs IS __Binary
                result := SELF:Equals( (__Binary) rhs)
            ELSE
                result := FALSE
            ENDIF
            RETURN result

        /// <inheritdoc />
        METHOD Equals(rhs AS __Binary ) AS LOGIC
            IF SELF:Length != rhs:Length
                RETURN FALSE
            ENDIF
            FOR VAR i := 0 to SELF:Length
                IF SELF:Value[i] != rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN TRUE

            /// <inheritdoc />
        OVERRIDE METHOD GetHashCode() AS INT
            RETURN SELF:_value:GetHashCode()

            /// <exclude />
        METHOD GetTypeCode() AS TypeCode
            RETURN TypeCode.Object

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR ==(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            RETURN lhs:Equals(rhs)

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR !=(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            RETURN ! lhs:Equals(rhs)
            #endregion

        #region Comparison Operators
        /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR >(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Length,rhs:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] > rhs:Value[i]
                    RETURN TRUE
                ELSEIF lhs:Value[i] < rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN FALSE

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR <(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Length,rhs:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] < rhs:Value[i]
                    RETURN TRUE
                ELSEIF lhs:Value[i] > rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN FALSE

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR >=(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Value:Length,rhs:Value:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] < rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN TRUE

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR <=(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Value:Length,rhs:Value:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] > rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN FALSE

            #endregion

        #region Implicit Converters
        /// <include file="RTComments.xml" path="Comments/Operator/*" />
        [DebuggerStepThroughAttribute];
        STATIC OPERATOR IMPLICIT(b AS BYTE[]) AS __Binary
            RETURN __Binary{b}

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        [DebuggerStepThroughAttribute];
        STATIC OPERATOR IMPLICIT(b AS __Binary) AS BYTE[]
            RETURN b:Value

        [DebuggerStepThroughAttribute];
        STATIC OPERATOR IMPLICIT(bytes AS __Binary) AS STRING
            var sb := StringBuilder{}
            foreach var b in bytes:Value
                sb:Append(Chr(b))
            next
            return sb:ToString()

            #endregion

        #region Numeric Operators

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR+(lhs AS __Binary, rhs AS __Binary) AS __Binary
            var len := lhs:Value:Length + rhs:Value:Length
            var result := byte[]{len}
            System.Array.Copy(lhs, result, lhs:Value:Length)
            System.Array.Copy(rhs, 0, result,lhs:Length, rhs:Value:Length)
            RETURN __Binary{result}

        /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR+(lhs AS __Binary, rhs AS STRING) AS STRING
            var sb := StringBuilder{}
            foreach var b in lhs:Value
                sb:Append(Chr(b))
            next
            sb:Append(rhs)
            RETURN sb:ToString()

        OPERATOR+(lhs AS STRING, rhs AS __Binary) AS STRING
            var sb := StringBuilder{}
            sb:Append(lhs)
            foreach var b in rhs:Value
                sb:Append(Chr(b))
            next
            RETURN sb:ToString()

        #endregion
        #region Unary Operators

            #endregion
        #region Add and Subtract
        /// <exclude />
        METHOD Add(rhs AS __Binary) AS __Binary
            RETURN SELF + rhs

        /// <inheritdoc />
        PUBLIC METHOD CompareTo(rhs AS __Binary) AS INT
            var len := Math.Min(SELF:Length,rhs:Length)
            for var i := 0 to len-1
                if SELF:Value[i] > rhs:Value[i]
                    return 1
                ELSEIF SELF:Value[i] < rhs:Value[i]
                    return -1
                ENDIF
            next
            if SELF:Length > rhs:Length
                RETURN 1
            ELSEIF SELF:Length < rhs:Length
                return -1
            ENDIF
            RETURN 0
            /// <inheritdoc />
        PUBLIC METHOD CompareTo(rhs AS OBJECT) AS INT
            RETURN SELF:CompareTo( (__Binary) rhs)
            #endregion

        #region IFormattable
        /// <inheritdoc />
        PUBLIC OVERRIDE METHOD ToString() AS STRING
            RETURN ToString("")

        /// <inheritdoc cref="M:System.Double.ToString(System.String)"/>
        PUBLIC METHOD ToString(sFormat AS STRING) AS STRING
            var sb := StringBuilder{}
            if sFormat == "G"
                foreach var b in self:Value
                    sb:Append(Chr(b))
                next
            else
                sb:Append("0h")
                foreach var b in self:Value
                    sb:Append(b:ToString("X"))
                next
            endif
            return sb:ToString()
            /// <inheritdoc />
        PUBLIC METHOD ToString(format AS STRING, provider AS System.IFormatProvider) AS STRING
            RETURN ToString(format)
            #endregion

    END STRUCTURE

END NAMESPACE

//
// Copyright (c) XSharp B.V.  All Rights Reserved.
// Licensed under the Apache License, Version 2.0.
// See License.txt in the project root for license information.
//
USING System
USING System.Text
USING System.Runtime.InteropServices
USING System.Runtime.CompilerServices
USING System.Diagnostics

BEGIN NAMESPACE XSharp
    // use explicit layout so we can compact the size into 12 bytes
    // Type is Immutable, so has no settable properties
    /// <summary>Internal type that implements the FoxPro Compatible CURRENCY type.
    /// This type has many operators and implicit converters that normally are never directly called from user code.
    /// The data in this type is stored as a System.Decimal with 4 decimal places
    /// </summary>
    /// <seealso cref="T:XSharp.__Float"/>
    /// <seealso cref="T:System.Decimal"/>
    PUBLIC STRUCTURE __Binary IMPLEMENTS IFormattable, ;
        IComparable<__Binary>, ;
        IEquatable<__Binary>, ;
        IComparable

        PRIVATE INITONLY _value AS BYTE[]

        #region constructors
        /// <include file="RTComments.xml" path="Comments/Constructor/*" />
        /// <param name="r8">Real8 value to convert to a FLOAT</param>
        [DebuggerStepThroughAttribute] [MethodImpl(MethodImplOptions.AggressiveInlining)];
        CONSTRUCTOR (b as Byte[])
            SELF:_value    := b

        #endregion
        #region Properties
        /// <summary>REAL8 (System.Double) value</summary>
        PROPERTY @@Value    AS Byte[]	GET _value
        PROPERTY Length as LONG GET @@Value:Length
        #endregion

        #region Equality Operators
        /// <inheritdoc />
        OVERRIDE METHOD Equals(rhs AS OBJECT  ) AS LOGIC
            LOCAL result AS LOGIC
            IF rhs != NULL .AND. rhs IS __Binary
                result := SELF:Equals( (__Binary) rhs)
            ELSE
                result := FALSE
            ENDIF
            RETURN result

        /// <inheritdoc />
        METHOD Equals(rhs AS __Binary ) AS LOGIC
            IF SELF:Length != rhs:Length
                RETURN FALSE
            ENDIF
            FOR VAR i := 0 to SELF:Length
                IF SELF:Value[i] != rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN TRUE

            /// <inheritdoc />
        OVERRIDE METHOD GetHashCode() AS INT
            RETURN SELF:_value:GetHashCode()

            /// <exclude />
        METHOD GetTypeCode() AS TypeCode
            RETURN TypeCode.Object

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR ==(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            RETURN lhs:Equals(rhs)

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR !=(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            RETURN ! lhs:Equals(rhs)
            #endregion

        #region Comparison Operators
        /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR >(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Length,rhs:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] > rhs:Value[i]
                    RETURN TRUE
                ELSEIF lhs:Value[i] < rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN FALSE

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR <(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Length,rhs:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] < rhs:Value[i]
                    RETURN TRUE
                ELSEIF lhs:Value[i] > rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN FALSE

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR >=(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Value:Length,rhs:Value:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] < rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN TRUE

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR <=(lhs AS __Binary, rhs AS __Binary) AS LOGIC
            var len := Math.Min(lhs:Value:Length,rhs:Value:Length)
            FOR VAR i := 0 to len-1
                IF lhs:Value[i] > rhs:Value[i]
                    RETURN FALSE
                ENDIF
            NEXT
            RETURN FALSE

            #endregion

        #region Implicit Converters
        /// <include file="RTComments.xml" path="Comments/Operator/*" />
        [DebuggerStepThroughAttribute];
        STATIC OPERATOR IMPLICIT(b AS BYTE[]) AS __Binary
            RETURN __Binary{b}

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        [DebuggerStepThroughAttribute];
        STATIC OPERATOR IMPLICIT(b AS __Binary) AS BYTE[]
            RETURN b:Value

        [DebuggerStepThroughAttribute];
        STATIC OPERATOR IMPLICIT(bytes AS __Binary) AS STRING
            var sb := StringBuilder{}
            foreach var b in bytes:Value
                sb:Append(Chr(b))
            next
            return sb:ToString()

            #endregion

        #region Numeric Operators

            /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR+(lhs AS __Binary, rhs AS __Binary) AS __Binary
            var len := lhs:Value:Length + rhs:Value:Length
            var result := byte[]{len}
            System.Array.Copy(lhs, result, lhs:Value:Length)
            System.Array.Copy(rhs, 0, result,lhs:Length, rhs:Value:Length)
            RETURN __Binary{result}

        /// <include file="RTComments.xml" path="Comments/Operator/*" />
        OPERATOR+(lhs AS __Binary, rhs AS STRING) AS STRING
            var sb := StringBuilder{}
            foreach var b in lhs:Value
                sb:Append(Chr(b))
            next
            sb:Append(rhs)
            RETURN sb:ToString()

        OPERATOR+(lhs AS STRING, rhs AS __Binary) AS STRING
            var sb := StringBuilder{}
            sb:Append(lhs)
            foreach var b in rhs:Value
                sb:Append(Chr(b))
            next
            RETURN sb:ToString()

        #endregion
        #region Unary Operators

            #endregion
        #region Add and Subtract
        /// <exclude />
        METHOD Add(rhs AS __Binary) AS __Binary
            RETURN SELF + rhs

        /// <inheritdoc />
        PUBLIC METHOD CompareTo(rhs AS __Binary) AS INT
            var len := Math.Min(SELF:Length,rhs:Length)
            for var i := 0 to len-1
                if SELF:Value[i] > rhs:Value[i]
                    return 1
                ELSEIF SELF:Value[i] < rhs:Value[i]
                    return -1
                ENDIF
            next
            if SELF:Length > rhs:Length
                RETURN 1
            ELSEIF SELF:Length < rhs:Length
                return -1
            ENDIF
            RETURN 0
            /// <inheritdoc />
        PUBLIC METHOD CompareTo(rhs AS OBJECT) AS INT
            RETURN SELF:CompareTo( (__Binary) rhs)
            #endregion

        #region IFormattable
        /// <inheritdoc />
        PUBLIC OVERRIDE METHOD ToString() AS STRING
            RETURN ToString("")

        /// <inheritdoc cref="M:System.Double.ToString(System.String)"/>
        PUBLIC METHOD ToString(sFormat AS STRING) AS STRING
            var sb := StringBuilder{}
            if sFormat == "G"
                foreach var b in self:Value
                    sb:Append(Chr(b))
                next
            else
                sb:Append("0h")
                foreach var b in self:Value
                    sb:Append(b:ToString("X"))
                next
            endif
            return sb:ToString()
            /// <inheritdoc />
        PUBLIC METHOD ToString(format AS STRING, provider AS System.IFormatProvider) AS STRING
            RETURN ToString(format)
            #endregion

    END STRUCTURE

END NAMESPACE