Merge pull request #2022 from github/console.log

Add `console.log` builtin for JavaScript and TypeScript

src/Control/Abstract/Primitive.hs

@@ -21,8 +21,8 @@ define :: ( HasCallStack
        -> Evaluator address value effects ()
 define name def = withCurrentCallStack callStack $ do
   addr <- alloc name
-  bind name addr
   def >>= assign addr
+  bind name addr
 
 defineClass :: ( AbstractValue address value effects
                , HasCallStack
@@ -41,6 +41,22 @@ defineClass name superclasses scope = define name $ do
     Env.newEnv . Env.head <$> getEnv
   klass name (map (string . formatName) superclasses) env
 
+defineNamespace :: ( AbstractValue address value effects
+                   , HasCallStack
+                   , Member (Allocator address value) effects
+                   , Member (Env address) effects
+                   , Member (Reader ModuleInfo) effects
+                   , Member (Reader Span) effects
+                   )
+                => Name
+                -> Evaluator address value effects a
+                -> Evaluator address value effects ()
+defineNamespace name scope = define name $ do
+  env <- locally $ do
+    void scope
+    Env.newEnv . Env.head <$> getEnv
+  namespace name env
+
 lambda :: (AbstractFunction address value effects, Member Fresh effects)
        => (Name -> Evaluator address value effects address)
        -> Evaluator address value effects value

src/Data/Abstract/Evaluatable.hs

@@ -145,13 +145,13 @@ class HasPrelude (language :: Language) where
 instance HasPrelude 'Go
 instance HasPrelude 'Haskell
 instance HasPrelude 'Java
-instance HasPrelude 'JavaScript
 instance HasPrelude 'PHP
 
 builtInPrint :: ( AbstractIntro value
                 , AbstractFunction address value effects
                 , Member (Resumable (EnvironmentError address)) effects
-                , Member (Env address) effects, Member (Allocator address value) effects)
+                , Member (Env address) effects
+                , Member (Allocator address value) effects)
              => Name
              -> Evaluator address value effects address
 builtInPrint v = do
@@ -170,9 +170,15 @@ instance HasPrelude 'Ruby where
     defineClass "Object" [] $ do
       define "inspect" (lambda (const (box (string "<object>"))))
 
-instance HasPrelude 'TypeScript
-  -- FIXME: define console.log using __semantic_print
+instance HasPrelude 'TypeScript where
+  definePrelude _ =
+    defineNamespace "console" $ do
+      define "log" (lambda builtInPrint)
 
+instance HasPrelude 'JavaScript where
+  definePrelude _ = do
+    defineNamespace "console" $ do
+      define "log" (lambda builtInPrint)
 
 -- Effects
 

src/Data/Abstract/Value/Concrete.hs

@@ -123,10 +123,10 @@ instance ( Coercible body (Eff effects)
     product <- foldl mergeEnvs lowerBound . catMaybes <$> traverse scopedEnvironment supers
     pure $ Class n (mergeEnvs product env)
 
-  namespace n env = do
-    maybeAddr <- lookupEnv n
+  namespace name env = do
+    maybeAddr <- lookupEnv name
     env' <- maybe (pure lowerBound) (asNamespaceEnv <=< deref) maybeAddr
-    pure (Namespace n (Env.mergeNewer env' env))
+    pure (Namespace name (Env.mergeNewer env' env))
     where asNamespaceEnv v
             | Namespace _ env' <- v = pure env'
             | otherwise             = throwValueError $ NamespaceError ("expected " <> show v <> " to be a namespace")