• R/O
  • HTTP
  • SSH
  • HTTPS

提交

标签
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#windowsobjective-ccocoa誰得qtpythonphprubygameguibathyscaphec計画中(planning stage)翻訳omegatframeworktwitterdomtestvb.netdirectxゲームエンジンbtronarduinopreviewer

A categorical programming language


Commit MetaInfo

修订版65b06ab9133989eaefb3312bbad8f37c34427471 (tree)
时间2023-01-30 16:33:19
作者Corbin <cds@corb...>
CommiterCorbin

Log Message

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.

更改概述

差异

--- a/movelist/cammy-djinn.scm
+++ b/movelist/cammy-djinn.scm
@@ -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)
117
128 (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))))
1412
1513 (match (map (lambda (s) (read (open-input-string s)))
1614 (command-line-arguments))
--- a/movelist/cammy-repl.scm
+++ b/movelist/cammy-repl.scm
@@ -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)
87
98 (define display-ty
109 (match-lambda
--- a/movelist/cammyo.scm
+++ b/movelist/cammyo.scm
@@ -1,9 +1,7 @@
11 (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)
75
86 ; Relate a monomorphic Cammy primitive to its input and output types.
97 ; This relation is just a table.
--- a/movelist/fp.scm
+++ b/movelist/fp.scm
@@ -3,12 +3,10 @@
33 fp-sign°
44 fp-<° fp-<=°
55 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))
1210
1311 ; An implementation of relational floating-point arithmetic, as seen in:
1412 ; https://www.cs.toronto.edu/~lczhang/sandre_float2021.pdf
@@ -46,7 +44,7 @@
4644 (list
4745 (if (<= 0.0 f) 'pos 'neg)
4846 (build-num (+ e exp-bias))
49- (build-num (inexact->exact (* exp-mantissa-factor m)))))]))
47+ (build-num (abs (inexact->exact (* exp-mantissa-factor m))))))]))
5048
5149 ; Convert a ground floating-point number into a Scheme inexact number.
5250 ; Float -> float
@@ -73,11 +71,16 @@
7371 (define fp-inf+ '(pos inf))
7472 (define fp-inf- '(neg inf))
7573
74+ (define (fp-finite° f)
75+ (conde
76+ ((== f fp-zero+)) ((== f fp-zero-))
77+ ((fresh (s e m) (== f `(,s ,e ,m))))))
78+
7679 ; The less-than relation.
7780 (define (fp-<° x y)
7881 (conde
79- ((== x fp-inf-))
80- ((== y fp-inf+))
82+ ((== x fp-inf-) (fp-finite° y))
83+ ((== y fp-inf+) (fp-finite° x))
8184 ((== x fp-zero+) (fresh (e m) (== y `(pos ,e ,m))))
8285 ((fresh (e m) (== x `(neg ,e ,m))) (== y fp-zero-))
8386 ((fp-neg° x) (fp-pos° y))