Merge pull request #202 from metadave/dp_oeis

add lookupSequence, extendSequence for OEIS access
disco-lang · Jun 19, 2020 · f9619b0 · f9619b0
2 parents fbf9357 + c5ea893
commit f9619b0
Show file tree

Hide file tree

Showing 10 changed files with 118 additions and 4 deletions.
diff --git a/disco.cabal b/disco.cabal
@@ -77,6 +77,8 @@ extra-source-files:  README.md, stack.yaml, example/*.disco, repl/*.hs
                      test/interp-lazymatch/bomb.disco
                      test/interp-lazymatch/expected
                      test/interp-lazymatch/input
+                     test/lib-oeis/expected
+                     test/lib-oeis/input
                      test/list-comp/expected
                      test/list-comp/input
                      test/list-poly/expected
@@ -117,8 +119,14 @@ extra-source-files:  README.md, stack.yaml, example/*.disco, repl/*.hs
                      test/props-fail/bad-tests.disco
                      test/props-fail/expected
                      test/props-fail/input
+                     test/repl-compile/expected
+                     test/repl-compile/input
                      test/repl-defn/expected
                      test/repl-defn/input
+                     test/repl-defns/expected
+                     test/repl-defns/input
+                     test/repl-desugar/expected
+                     test/repl-desugar/input
                      test/repl-import/expected
                      test/repl-import/input
                      test/solver-issue112/diag-iso-bad.disco
@@ -270,7 +278,8 @@ library
                        haskeline >=0.7 && <0.8,
                        QuickCheck >= 2.9 && < 2.14,
                        fgl >= 5.5 && < 5.8,
-                       optparse-applicative >= 0.12 && < 0.16
+                       optparse-applicative >= 0.12 && < 0.16,
+                       oeis >= 0.3.10
 
   hs-source-dirs:      src
   default-language:    Haskell2010
@@ -289,7 +298,8 @@ executable disco
                        containers >= 0.5 && < 0.7,
                        unbound-generics >= 0.3 && < 0.5,
                        lens >= 4.14 && < 4.19,
-                       optparse-applicative >= 0.12 && < 0.16
+                       optparse-applicative >= 0.12 && < 0.16,
+                       oeis >= 0.3.10
 
   default-language:    Haskell2010
 

diff --git a/lib/oeis.disco b/lib/oeis.disco
@@ -0,0 +1,13 @@
+using Primitives
+
+||| Lookup a sequence of integers using https://oeis.org
+!!!  lookupSequence [] == left ()
+!!!  lookupSequence [1,1,2,3] == right "https://oeis.org/A000045"
+lookupSequence : List N -> Unit + List Char
+lookupSequence = $lookupSequence
+
+||| Extend a known sequence of integers with data from https://oeis.org
+!!!  extendSequence [] == []
+!!!  extendSequence [1,1,2,3,5] == [1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, 317811, 514229, 832040, 1346269, 2178309, 3524578, 5702887, 9227465, 14930352, 24157817, 39088169, 63245986, 102334155]
+extendSequence : List N -> List N
+extendSequence = $extendSequence
diff --git a/src/Disco/AST/Core.hs b/src/Disco/AST/Core.hs
@@ -177,6 +177,8 @@ data Op = OAdd      -- ^ Addition (@+@)
         -- Other primitives
         | OCrash          -- ^ Crash with a user-supplied message
         | OId             -- ^ No-op/identity function
+        | OLookupSeq      -- ^ Lookup OEIS sequence
+        | OExtendSeq      -- ^ Extend a List via OEIS
 
   deriving (Show, Generic)
 

diff --git a/src/Disco/Compile.hs b/src/Disco/Compile.hs
@@ -191,6 +191,9 @@ compilePrim _ PrimCrash   = return $ CConst OCrash
 compilePrim _ PrimForever = return $ CConst OForever
 compilePrim _ PrimUntil   = return $ CConst OUntil
 
+compilePrim _ PrimLookupSeq   = return $ CConst OLookupSeq
+compilePrim _ PrimExtendSeq   = return $ CConst OExtendSeq
+
 compilePrimErr :: Prim -> Type -> a
 compilePrimErr p ty = error $ "Impossible! compilePrim " ++ show p ++ " on bad type " ++ show ty
 

diff --git a/src/Disco/Interpret/Core.hs b/src/Disco/Interpret/Core.hs
@@ -80,6 +80,10 @@ import           Disco.Context
 import           Disco.Eval
 import           Disco.Types
 
+import           Math.OEIS                               (catalogNums,
+                                                          extendSequence,
+                                                          lookupSequence)
+
 ------------------------------------------------------------
 -- Evaluation
 ------------------------------------------------------------
@@ -397,6 +401,7 @@ toDiscoList (x : xs) = do
   xsv <- mkSimple =<< delay (toDiscoList xs)
   return $ VCons 1 [xv, xsv]
 
+
 -- | Convert a Value representing a disco list into a Haskell list of
 --   Values.  Strict in the spine of the list.
 fromDiscoList :: Value -> Disco IErr [Value]
@@ -908,6 +913,9 @@ whnfOp OUntil          = arity2 "until"     $ ellipsis . Until
 whnfOp OCrash          = arity1 "crash"     $ whnfV >=> primCrash
 whnfOp OId             = arity1 "id" $ whnfV
 
+whnfOp OExtendSeq      = arity1 "extendSequence" $ oeisExtend
+whnfOp OLookupSeq      = arity1 "lookupSequence" $ oeisLookup
+
 --------------------------------------------------
 -- Utility functions
 
@@ -1504,3 +1512,44 @@ primValOrd (VCons i []) (VCons j []) = compare i j
 primValOrd (VNum _ n1)  (VNum _ n2)  = compare n1 n2
 primValOrd v1           v2
   = error $ "primValOrd: impossible! (got " ++ show v1 ++ ", " ++ show v2 ++ ")"
+
+
+------------------------------------------------------------
+-- OEIS
+------------------------------------------------------------
+
+-- | Looks up a sequence of integers in OEIS.
+--   Returns 'left()' if the sequence is unknown in OEIS,
+--   otherwise 'right "https://oeis.org/<oeis_sequence_id>"'
+oeisLookup :: Value -> Disco IErr Value
+oeisLookup v = do
+    vs <- fromDiscoList v
+    let hvs = toHaskellList vs
+    case lookupSequence hvs of
+      Just result -> parseResult result
+      Nothing     -> return leftUnit
+  where
+    parseResult r = do
+          let sequence = getCatalogNum $ catalogNums r
+          l <- toDiscoList $ toVal ("https://oeis.org/" ++ sequence)
+          return $ VCons 1 [l] -- right "https://oeis.org/foo"
+    getCatalogNum []    = error "No catalog info"
+    getCatalogNum (n:_) = n
+    toVal = map (\c -> vnum (toInteger (ord c) % 1))
+    leftUnit = VCons 0 [VCons 0 []]
+
+-- | Extends a Disco integer list with data from a known OEIS sequence.
+--   Returns a list of integers upon success, otherwise the original list (unmodified).
+oeisExtend :: Value -> Disco IErr Value
+oeisExtend v = do
+    vs <- fromDiscoList v
+    let xs = toHaskellList vs
+    let newseq = extendSequence xs
+    toDiscoList $ map (vnum . (%1)) newseq
+
+-- | Convert a Disco integer list to a Haskell list
+toHaskellList [] = []
+toHaskellList xs = map fromVNum xs
+                   where
+                      fromVNum (VNum _ x) = fromIntegral $ numerator x
+                      fromVNum v          = error $ "Impossible!  fromVNum on " ++ show v
diff --git a/src/Disco/Syntax/Prims.hs b/src/Disco/Syntax/Prims.hs
@@ -67,6 +67,8 @@ data Prim where
 
   PrimForever :: Prim      -- ^ @[x, y, z .. ]@
   PrimUntil   :: Prim      -- ^ @[x, y, z .. e]@
+  PrimLookupSeq :: Prim    -- ^ Lookup OEIS sequence
+  PrimExtendSeq :: Prim    -- ^ Extend OEIS sequence
   deriving (Show, Read, Eq, Ord, Generic)
 
 instance Alpha Prim
@@ -134,6 +136,8 @@ primTable =
 
   , PrimInfo PrimForever   "forever" False
   , PrimInfo PrimUntil     "until"   False
+  , PrimInfo PrimLookupSeq "lookupSequence" False
+  , PrimInfo PrimExtendSeq "extendSequence" False
   ]
 
 -- | A convenient map from each 'Prim' to its info record.

diff --git a/src/Disco/Typecheck.hs b/src/Disco/Typecheck.hs
@@ -753,6 +753,9 @@ typecheck Infer (TPrim prim) = do
 
       return $ TyContainer c a :->: TyContainer c (TyContainer c a)
 
+    inferPrim PrimLookupSeq = return $ TyList TyN :->: (TyUnit :+: TyString)
+    inferPrim PrimExtendSeq = return $ TyList TyN :->: TyList TyN
+
 --------------------------------------------------
 -- Base types
 

diff --git a/stack.yaml b/stack.yaml
@@ -6,18 +6,18 @@ resolver: lts-15.14
 
 # Local packages, usually specified by relative directory name
 packages:
-- '.'
+  - "."
 
 # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3)
 extra-deps:
   - unbound-generics-0.4.0
+  - oeis-0.3.10
 
 # Override default flag values for local packages and extra-deps
 flags: {}
 
 # Extra package databases containing global packages
 extra-package-dbs: []
-
 # Control whether we use the GHC we find on the path
 # system-ghc: true
 

diff --git a/test/lib-oeis/expected b/test/lib-oeis/expected
@@ -0,0 +1,8 @@
+Loading oeis.disco...
+right "https://oeis.org/A000045"
+left ()
+left ()
+[1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55, 57, 59, 61, 63, 65, 67, 69, 71, 73, 75, 77, 79, 81, 83, 85, 87, 89, 91, 93, 95, 97, 99, 101, 103, 105, 107, 109, 111, 113, 115, 117, 119, 121, 123, 125, 127, 129, 131]
+[]
+[1, 10011]
+[1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55, 57, 59, 61, 63, 65, 67, 69, 71, 73, 75, 77, 79, 81, 83, 85, 87, 89, 91, 93, 95, 97, 99, 101, 103, 105, 107, 109, 111, 113, 115, 117, 119, 121, 123, 125, 127, 129, 131]
diff --git a/test/lib-oeis/input b/test/lib-oeis/input
@@ -0,0 +1,22 @@
+import oeis
+
+-- valid sequence
+lookupSequence [1,1,2,3,5]
+
+-- empty list
+lookupSequence []
+
+-- unknown sequence
+lookupSequence [1,10011]
+
+-- known sequence
+extendSequence [1,3,5,7]
+
+-- empty list
+extendSequence []
+
+-- unknown sequence
+extendSequence [1,10011]
+
+-- extend a long sequence
+extendSequence [1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55,57,59,61,63,65,67,69,71,73,75,77,79,81,83,85,87,89,91,93,95,97,99]