A categorical programming language
| Revision | 65b06ab9133989eaefb3312bbad8f37c34427471 (tree) |
|---|---|
| Time | 2023-01-30 16:33:19 |
| Author | Corbin <cds@corb...> |
| Commiter | Corbin |
Clean up imports, fix FP unifications.
FP values are still off by a bit, but this seems to work for f-lt and
f-sign, at least.
movelist/cammy-djinn.scm (diff) movelist/cammy-repl.scm (diff) movelist/cammyo.scm (diff) movelist/fp.scm (diff)| @@ -1,16 +1,14 @@ | ||
| 1 | -(import (chicken pretty-print)) | |
| 2 | -(import (chicken process-context)) | |
| 3 | -(import (matchable)) | |
| 4 | -(import (mini-kanren)) | |
| 5 | - | |
| 6 | -(import (cammyo)) | |
| 7 | - | |
| 8 | -(define (print-each xs) | |
| 9 | - (if (null? xs) #f | |
| 10 | - (begin (display (car xs)) (newline) (print-each (cdr xs))))) | |
| 1 | +(import scheme | |
| 2 | + mini-kanren | |
| 3 | + (chicken pretty-print) | |
| 4 | + (chicken process-context) | |
| 5 | + (only matchable match) | |
| 6 | + cammyo) | |
| 11 | 7 | |
| 12 | 8 | (define (djinn x s t) |
| 13 | - (print-each (run x (q) (cammy° q s t)))) | |
| 9 | + (for-each | |
| 10 | + (lambda (expr) (display expr) (newline)) | |
| 11 | + (run x (q) (cammy° q s t)))) | |
| 14 | 12 | |
| 15 | 13 | (match (map (lambda (s) (read (open-input-string s))) |
| 16 | 14 | (command-line-arguments)) |
| @@ -1,10 +1,9 @@ | ||
| 1 | -(import (srfi-132)) | |
| 2 | -(import (chicken pretty-print)) | |
| 3 | -(import (chicken time)) | |
| 4 | -(import (matchable)) | |
| 5 | -(import (mini-kanren)) | |
| 6 | - | |
| 7 | -(import (fp) (rels) (cammyo)) | |
| 1 | +(import scheme | |
| 2 | + (srfi 132) | |
| 3 | + mini-kanren | |
| 4 | + (chicken time) | |
| 5 | + matchable | |
| 6 | + fp rels cammyo) | |
| 8 | 7 | |
| 9 | 8 | (define display-ty |
| 10 | 9 | (match-lambda |
| @@ -1,9 +1,7 @@ | ||
| 1 | 1 | (module cammyo (cammy° cammy-prim° eval°) |
| 2 | - (import scheme) | |
| 3 | - (import (chicken pretty-print)) | |
| 4 | - (import (mini-kanren)) | |
| 5 | - | |
| 6 | - (import (fp) (rels)) | |
| 2 | + (import scheme | |
| 3 | + mini-kanren | |
| 4 | + fp rels) | |
| 7 | 5 | |
| 8 | 6 | ; Relate a monomorphic Cammy primitive to its input and output types. |
| 9 | 7 | ; This relation is just a table. |
| @@ -3,12 +3,10 @@ | ||
| 3 | 3 | fp-sign° |
| 4 | 4 | fp-<° fp-<=° |
| 5 | 5 | fp-zero+ fp-zero- fp-inf+ fp-inf-) |
| 6 | - (import scheme) | |
| 7 | - (import (chicken base)) | |
| 8 | - (import (chicken pretty-print)) | |
| 9 | - (import (matchable)) | |
| 10 | - (import (mathh)) | |
| 11 | - (import (mini-kanren)) | |
| 6 | + (import scheme (chicken base) | |
| 7 | + mini-kanren | |
| 8 | + (only matchable match-lambda) | |
| 9 | + (only mathh frexp)) | |
| 12 | 10 | |
| 13 | 11 | ; An implementation of relational floating-point arithmetic, as seen in: |
| 14 | 12 | ; https://www.cs.toronto.edu/~lczhang/sandre_float2021.pdf |
| @@ -46,7 +44,7 @@ | ||
| 46 | 44 | (list |
| 47 | 45 | (if (<= 0.0 f) 'pos 'neg) |
| 48 | 46 | (build-num (+ e exp-bias)) |
| 49 | - (build-num (inexact->exact (* exp-mantissa-factor m)))))])) | |
| 47 | + (build-num (abs (inexact->exact (* exp-mantissa-factor m))))))])) | |
| 50 | 48 | |
| 51 | 49 | ; Convert a ground floating-point number into a Scheme inexact number. |
| 52 | 50 | ; Float -> float |
| @@ -73,11 +71,16 @@ | ||
| 73 | 71 | (define fp-inf+ '(pos inf)) |
| 74 | 72 | (define fp-inf- '(neg inf)) |
| 75 | 73 | |
| 74 | + (define (fp-finite° f) | |
| 75 | + (conde | |
| 76 | + ((== f fp-zero+)) ((== f fp-zero-)) | |
| 77 | + ((fresh (s e m) (== f `(,s ,e ,m)))))) | |
| 78 | + | |
| 76 | 79 | ; The less-than relation. |
| 77 | 80 | (define (fp-<° x y) |
| 78 | 81 | (conde |
| 79 | - ((== x fp-inf-)) | |
| 80 | - ((== y fp-inf+)) | |
| 82 | + ((== x fp-inf-) (fp-finite° y)) | |
| 83 | + ((== y fp-inf+) (fp-finite° x)) | |
| 81 | 84 | ((== x fp-zero+) (fresh (e m) (== y `(pos ,e ,m)))) |
| 82 | 85 | ((fresh (e m) (== x `(neg ,e ,m))) (== y fp-zero-)) |
| 83 | 86 | ((fp-neg° x) (fp-pos° y)) |
Fork