Skip to content
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions racket/prologos/data/benchmarks/timings.jsonl

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion racket/prologos/data/cache/pnet/prologos/data/nat.pnet

Large diffs are not rendered by default.

244 changes: 199 additions & 45 deletions racket/prologos/foreign.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -5,22 +5,33 @@
;;; Converts between Prologos values (Church/Peano encoded) and Racket values.
;;;
;;; Supported base types:
;;; Nat ↔ exact non-negative integer
;;; Bool ↔ boolean
;;; Unit ↔ void
;;; Char ↔ char
;;; String ↔ string
;;; Nat ↔ exact non-negative integer
;;; Int ↔ exact integer
;;; Rat ↔ exact rational
;;; Bool ↔ boolean
;;; Unit ↔ void
;;; Char ↔ char
;;; String ↔ string
;;; Posit8/16/32/64 ↔ exact rational (semantic value; NaR raises an error)
;;; List <T> ↔ list of marshalled elements (recursive in T)
;;;

(require racket/match
racket/string
"syntax.rkt")
"syntax.rkt"
"posit-impl.rkt")

(provide marshal-prologos->racket
marshal-racket->prologos
nat->integer
integer->nat
bool->boolean
int->integer
integer->int
posit->rational
rational->posit
prologos-list->racket-list
racket-list->prologos-list
parse-foreign-type
make-marshaller-pair
base-type-name)
Expand Down Expand Up @@ -70,22 +81,112 @@
[(expr-string v) v]
[_ (error 'foreign "Cannot marshal to string — not a String literal: ~a" e)]))

;; Convert a Prologos Posit (any width) to a Racket exact rational.
;; NaR contamination raises an error since rationals cannot represent NaR.
(define (posit->rational e)
(define-values (width bits)
(match e
[(expr-posit8 v) (values 8 v)]
[(expr-posit16 v) (values 16 v)]
[(expr-posit32 v) (values 32 v)]
[(expr-posit64 v) (values 64 v)]
[_ (error 'foreign "Cannot marshal to rational — not a Posit literal: ~a" e)]))
(define r
(case width
[(8) (posit8-to-rational bits)]
[(16) (posit16-to-rational bits)]
[(32) (posit32-to-rational bits)]
[(64) (posit64-to-rational bits)]))
(when (eq? r 'nar)
(error 'foreign "Cannot marshal Posit~a NaR to rational" width))
r)

;; Helpers: recognize cons/nil names regardless of namespace qualification.
(define (list-cons-name? name)
(and (symbol? name)
(let ([s (symbol->string name)])
(or (string=? s "cons")
(let ([len (string-length s)])
(and (>= len 6)
(string=? (substring s (- len 6)) "::cons")))))))

(define (list-nil-name? name)
(and (symbol? name)
(let ([s (symbol->string name)])
(or (string=? s "nil")
(let ([len (string-length s)])
(and (>= len 5)
(string=? (substring s (- len 5)) "::nil")))))))

;; Walk a Prologos List value (cons/nil chain) into a Racket list of element exprs.
;; Recognizes both forms:
;; - (cons head tail) — 2-arg form, no type argument
;; - (cons A head tail) — 3-arg form with implicit type argument
;; - nil / (expr-nil) — bare nil
;; - (nil A) — nil applied to type argument
;; Errors on a stuck or non-list expression.
(define (prologos-list->racket-list e)
(let loop ([cur e] [acc '()])
(cond
;; (expr-nil) — built-in nil node
[(expr-nil? cur)
(reverse acc)]
;; bare 'nil / qualified ::nil fvar
[(and (expr-fvar? cur) (list-nil-name? (expr-fvar-name cur)))
(reverse acc)]
;; (nil A) — nil with type argument
[(and (expr-app? cur)
(let ([f (expr-app-func cur)])
(and (expr-fvar? f) (list-nil-name? (expr-fvar-name f)))))
(reverse acc)]
;; cons applications: 2-arg ((cons head) tail) or 3-arg (((cons A) head) tail)
[(expr-app? cur)
(define head-app (expr-app-func cur))
(define tail (expr-app-arg cur))
(cond
;; ((cons head) tail) — 2-arg
[(and (expr-app? head-app)
(let ([f (expr-app-func head-app)])
(and (expr-fvar? f) (list-cons-name? (expr-fvar-name f)))))
(loop tail (cons (expr-app-arg head-app) acc))]
;; (((cons A) head) tail) — 3-arg with type
[(and (expr-app? head-app)
(expr-app? (expr-app-func head-app))
(let ([f (expr-app-func (expr-app-func head-app))])
(and (expr-fvar? f) (list-cons-name? (expr-fvar-name f)))))
(loop tail (cons (expr-app-arg head-app) acc))]
[else
(error 'foreign "Cannot marshal to list — not a cons/nil chain: ~a" e)])]
[else
(error 'foreign "Cannot marshal to list — not a cons/nil chain: ~a" e)])))

(define (marshal-prologos->racket base-type val)
(case base-type
[(Nat) (nat->integer val)]
[(Int) (int->integer val)]
[(Rat) (rat->rational val)]
[(Bool) (bool->boolean val)]
[(Unit) (void)]
[(Char) (char->rkt-char val)]
[(String) (string->rkt-string val)]
;; Passthrough types: the Prologos IR value IS the Racket value
[(Path Keyword Passthrough) val]
(cond
;; Compound List type: (List <inner>)
[(and (pair? base-type) (eq? (car base-type) 'List))
(define inner (cadr base-type))
(map (lambda (e) (marshal-prologos->racket inner e))
(prologos-list->racket-list val))]
;; Atomic types
[(symbol? base-type)
(case base-type
[(Nat) (nat->integer val)]
[(Int) (int->integer val)]
[(Rat) (rat->rational val)]
[(Bool) (bool->boolean val)]
[(Unit) (void)]
[(Char) (char->rkt-char val)]
[(String) (string->rkt-string val)]
[(Posit8 Posit16 Posit32 Posit64) (posit->rational val)]
;; Passthrough types: the Prologos IR value IS the Racket value
Comment on lines +207 to +213

Copilot AI Apr 28, 2026

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

marshal-prologos->racket treats all Posit widths the same by calling posit->rational, so a Posit8-typed position will also accept an expr-posit16/32/64 (and vice versa). That silently defeats the width distinction and can hide type mismatches/precision issues. Consider dispatching per Posit type and rejecting mismatched IR constructors (e.g., Posit8 should only accept expr-posit8?).

Copilot uses AI. Check for mistakes.
[(Path Keyword Passthrough) val]
[else
(define type-str (symbol->string base-type))
(if (string-prefix? type-str "Opaque:")
(if (expr-opaque? val) (expr-opaque-value val) val)
(error 'foreign "Unsupported marshal-in type: ~a" base-type))])]
[else
(define type-str (symbol->string base-type))
(if (string-prefix? type-str "Opaque:")
(if (expr-opaque? val) (expr-opaque-value val) val)
(error 'foreign "Unsupported marshal-in type: ~a" base-type))]))
(error 'foreign "Unsupported marshal-in type: ~a" base-type)]))

;; ========================================
;; Racket → Prologos marshalling
Expand All @@ -110,45 +211,98 @@
(error 'foreign "Cannot marshal from Racket: expected exact rational, got ~a" n))
(expr-rat n))

;; Convert a Racket exact rational (or integer) to a Prologos Posit literal of the given width.
(define (rational->posit width n)
(unless (or (exact-integer? n) (and (exact? n) (rational? n)))
(error 'foreign
"Cannot marshal to Posit~a: expected exact integer or rational, got ~a"
width n))
(case width
[(8) (expr-posit8 (posit8-encode n))]
[(16) (expr-posit16 (posit16-encode n))]
[(32) (expr-posit32 (posit32-encode n))]
[(64) (expr-posit64 (posit64-encode n))]
[else (error 'foreign "Unknown Posit width: ~a" width)]))

;; Build a Prologos List value from a Racket list of element exprs.
;; Uses the bare 'cons / (expr-nil) form (no implicit type argument), which the
;; reducer/elaborator accepts and pretty-printer recognizes.
(define (racket-list->prologos-list elems)
(foldr (lambda (e acc)
(expr-app (expr-app (expr-fvar 'cons) e) acc))
(expr-nil)
elems))

(define (marshal-racket->prologos base-type val)
(case base-type
[(Nat) (integer->nat val)]
[(Int) (integer->int val)]
[(Rat) (rational->rat val)]
[(Bool) (if val (expr-true) (expr-false))]
[(Unit) (expr-unit)]
[(Char) (expr-char val)]
[(String) (expr-string val)]
;; Passthrough types: result is already a Prologos IR value
[(Path Keyword Passthrough) val]
(cond
;; Compound List type: (List <inner>)
[(and (pair? base-type) (eq? (car base-type) 'List))
(define inner (cadr base-type))
(unless (list? val)
(error 'foreign "Cannot marshal to List — expected Racket list, got ~a" val))
(racket-list->prologos-list
(map (lambda (e) (marshal-racket->prologos inner e)) val))]
;; Atomic types
[(symbol? base-type)
(case base-type
[(Nat) (integer->nat val)]
[(Int) (integer->int val)]
[(Rat) (rational->rat val)]
[(Bool) (if val (expr-true) (expr-false))]
[(Unit) (expr-unit)]
[(Char) (expr-char val)]
[(String) (expr-string val)]
[(Posit8) (rational->posit 8 val)]
[(Posit16) (rational->posit 16 val)]
[(Posit32) (rational->posit 32 val)]
[(Posit64) (rational->posit 64 val)]
;; Passthrough types: result is already a Prologos IR value
[(Path Keyword Passthrough) val]
[else
(define type-str (symbol->string base-type))
(if (string-prefix? type-str "Opaque:")
(expr-opaque val (string->symbol (substring type-str 7)))
(error 'foreign "Unsupported marshal-out type: ~a" base-type))])]
[else
(define type-str (symbol->string base-type))
(if (string-prefix? type-str "Opaque:")
(expr-opaque val (string->symbol (substring type-str 7)))
(error 'foreign "Unsupported marshal-out type: ~a" base-type))]))
(error 'foreign "Unsupported marshal-out type: ~a" base-type)]))

;; ========================================
;; Type parsing for marshalling
;; ========================================

;; Extract base type symbol from a core type expression.
;; Returns one of: 'Nat, 'Bool, 'Unit, 'Posit8
;; Extract base type descriptor from a core type expression.
;; Returns either:
;; - a symbol for atomic types: 'Nat, 'Int, 'Rat, 'Bool, 'Unit, 'Char, 'String,
;; 'Posit8, 'Posit16, 'Posit32, 'Posit64, 'Path, 'Keyword, 'Passthrough,
;; 'Opaque:<tag>
;; - a list (List <inner>) for the polymorphic List type, where <inner> is
;; itself a base-type descriptor (atomic or nested List).
(define (base-type-name e)
(match e
[(expr-Nat) 'Nat]
[(expr-Bool) 'Bool]
[(expr-Unit) 'Unit]
[(expr-Posit8) 'Posit8]
[(expr-Nat) 'Nat]
[(expr-Bool) 'Bool]
[(expr-Unit) 'Unit]
[(expr-Posit8) 'Posit8]
[(expr-Posit16) 'Posit16]
[(expr-Posit32) 'Posit32]
[(expr-Posit64) 'Posit64]
[(expr-Int) 'Int]
[(expr-Rat) 'Rat]
[(expr-Char) 'Char]
[(expr-String) 'String]
[(expr-Int) 'Int]
[(expr-Rat) 'Rat]
[(expr-Char) 'Char]
[(expr-String) 'String]
;; Passthrough types: Path, Keyword — Racket functions operate on IR values directly
[(expr-Path) 'Path]
[(expr-Path) 'Path]
[(expr-Keyword) 'Keyword]
;; (List A) — recognize bare and namespace-qualified List names
[(expr-app (? (lambda (f)
(and (expr-fvar? f)
(let* ([n (symbol->string (expr-fvar-name f))]
[len (string-length n)])
(or (string=? n "List")
(and (>= len 6)
(string=? (substring n (- len 6)) "::List")))))))
inner)
(list 'List (base-type-name inner))]
;; Any other type: passthrough (the Racket function handles IR values directly)
[_ 'Passthrough]))

Expand Down
Loading
Loading