Implemented fix:gcd.
authorTim Vaughan <tgvaughan@gmail.com>
Mon, 19 Dec 2016 18:50:27 +0000 (07:50 +1300)
committerTim Vaughan <tgvaughan@gmail.com>
Mon, 19 Dec 2016 18:50:27 +0000 (07:50 +1300)
src/scheme-primitives.4th

index 5ec154b..7e123f7 100644 (file)
     swap abs swap
 ; 1 make-fa-primitive fix:abs
 
+: sort-pair
+    2dup > if
+        swap
+    then
+;
 
 ( Find the GCD of n1 and n2 where n2 < n1. )
 : gcd ( n1 n2 -- m )
-    
+    sort-pair
+    over 0= if
+        swap drop
+    else
+        over mod
+        recurse
+    then
 ;
 
+:noname ( fixnum fixnum -- fixnum' )
+    drop swap drop gcd fixnum-type
+; 2 make-fa-primitive fix:gcd
+
 \ --- Flonums ---
 
 :noname ( flonum flonum -- bool )