guise-lang/examples/tuples.guise

;; Tuple examples - demonstrating Factor-style BOA construction

;; Define a 2D point tuple (no arrow = tuple definition)
(define point (x float) (y float))

;; Note: make-point constructor is auto-generated
;; Stack effect: (float float -> point)

(define origin ( -> point)
  (0.0 0.0 make-point))     ; Stack: [] → [point{x:0.0, y:0.0}]

(define unit-x ( -> point)
  (1.0 0.0 make-point))     ; point{x:1.0, y:0.0}

;; Accessing fields
(define get-x (point -> float)
  (.x))                ; Extract x field

(define get-y (point -> float)
  (.y))                ; Extract y field

;; Pattern matching destructures in order
(define point-magnitude (point -> float)
  (match
    ((point x y) →     ; Pushes x, then y onto stack
      x dup *          ; x²
      y dup *          ; y²
      + sqrt)))        ; √(x² + y²)

;; Functional update (creates new tuple)
(define move-x (point float -> make-point)
  (swap               ; [point dx]
   dup .x             ; [point dx x]
   rot +              ; [point x']
   swap .y            ; [x' point y]
   swap               ; [x' y point]
   drop               ; [x' y]
   make-point))            ; Reconstruct with new x

;; Or using update syntax
(define move-x-v2 (point float -> make-point)
  (over .x +          ; Calculate new x
   swap .y            ; Get old y
   make-point))            ; Reconstruct

;; Complex tuple
(define person
  (name string)
  (age int)
  (email string))

;; Example person (uses auto-generated make-person)
(define alice ( -> person)
  ("Alice" 30 "alice@example.com" make-person))

;; Accessor
(define person-name (person -> string)
  (.name))

;; Pattern match all fields
(define person-info (person -> )
  (match
    ((person name age email) →
      "Name: " display name display
      ", Age: " display age display
      ", Email: " display email display)))

;; Nested tuples
(define rect
  (top-left point)
  (bottom-right point))

;; Create rectangle from coordinates
(define make-rect (float float float float -> rect)
  (make-point              ; Construct bottom-right
   swap rot swap           ; Shuffle for top-left
   make-point              ; Construct top-left
   swap                    ; Swap to correct order
   make-rect))             ; Construct rectangle

;; Calculate rectangle area
(define rect-area (rect -> float)
  (match
    ((rect (point x1 y1) (point x2 y2)) →
      x2 x1 - abs
      y2 y1 - abs
      *)))

;; Generic operations on tuples
(define vec2
  (x float)
  (y float))

;; Add two vectors using BOA
(define vec2-add (vec2 vec2 -> vec2)
  (match
    ((vec2 x2 y2) →    ; Destructure second (top of stack)
      (match
        ((vec2 x1 y1) →  ; Destructure first
          x1 x2 +        ; Add x components
          y1 y2 +        ; Add y components
          make-vec2)))))      ; BOA reconstruction

;; Alternative: use slot access
(define vec2-add-v2 (vec2 vec2 -> vec2)
  (over .x over .x +   ; Add x's
   rot .y rot .y +     ; Add y's
   make-vec2))              ; Reconstruct

;; Scalar multiplication
(define vec2-scale (vec2 float -> vec2)
  (swap
   match
     ((vec2 x y) →
       rot             ; [x y scalar]
       dup rot *       ; [scalar x*scalar y]
       swap rot *      ; [x*scalar y*scalar]
       make-vec2)))

;; Dot product
(define vec2-dot (vec2 vec2 -> float)
  (match
    ((vec2 x2 y2) →
      (match
        ((vec2 x1 y1) →
          x1 x2 *
          y1 y2 *
          +)))))

;; Three-component vector
(define vec3
  (x float)
  (y float)
  (z float))

;; Cross product
(define vec3-cross (vec3 vec3 -> vec3)
  (match
    ((vec3 bx by bz) →
      (match
        ((vec3 ax ay az) →
          ay bz * az by * -   ; cx
          az bx * ax bz * -   ; cy
          ax by * ay bx * -   ; cz
          make-vec3)))))

;; Anonymous tuples (quick pairs, triples)
(define swap-pair ((tuple 'a 'b) -> (tuple 'b 'a))
  (match
    ((tuple x y) → y x tuple2)))

;; Three-way rotation
(define rot3 ((tuple 'a 'b 'c) -> (tuple 'b 'c 'a))
  (match
    ((tuple x y z) → y z x tuple3)))