Commits

Even Wiik Thomassen  committed 3e33164 Merge

Merged khs.

  • Participants
  • Parent commits cdfa4e3, 1ed5618
  • Branches even

Comments (0)

Files changed (10)

File pyhaskell/builtin/base.py

 # -----------------------------------------------------------------
 # base:GHC.Base
 # -----------------------------------------------------------------
-from pyhaskell.interpreter import haskell, module, types
+from pyhaskell.interpreter import haskell, module
+from pyhaskell.interpreter.types import true, false, Char, Int, Addr
 
+from builtin import types
+
+import copy
 
 mod = module.CoreMod("base:GHC.Base")
 
 # List concatenation (++)
 @mod.expose("++", 2)
 def concatenation(args):
+    def conc(a, b):
+        if len(a.getargs() ) > 1:
+            return haskell.constr(":", a.getarg(0), conc(a.getarg(1), b) )
+        else:
+            return b
+
     a, b = args
-    return types.Addr(a.value + b.value)
+    t = conc(a,b)
+
+    return t 
 
 
 # Non-strict application operator ($)
 def zd(args):
     a, b = args
     return haskell.make_partial_app(a, [b])
+
+
+# Function 1 is evaluated before function 2 (>>)
+@mod.expose(">>", 2)
+def s(args):
+    a, b = args
+    f1 = a
+    f2 = haskell.function(">>", [([haskell.Var("_")], b)])
+    app = haskell.make_application(b, [a])
+    return app
+
+class IO(haskell.Value):
+    _immutable_fields_ = ["value"]
+
+    def __init__(self, a):
+        self.value = a
+
+    def tostr(self):
+        return str(self.value)
+
+mod.qvars["$fMonadIO"] = IO("()")

File pyhaskell/builtin/cstring.py

-from pyhaskell.interpreter import module
+from pyhaskell.interpreter import haskell, module
+from pyhaskell.interpreter.types import Int, Char, Addr, Double
 
+from pyhaskell.builtin import types 
 
 mod = module.CoreMod("ghc-prim:GHC.CString")
 
+
 @mod.expose("unpackCString#", 1)
 def unpackCString(args):
-    return args[0]
 
+    a = args[0]
+    b = str(a.value)
+
+    t = types.zmzn 
+
+    for i in range(len(b)-1, -1, -1):
+        c = haskell.constr( "Czh", Char(b[i]) )
+        t = haskell.constr( ":", c, t )
+
+    return t 
+

File pyhaskell/builtin/io.py

 # -----------------------------------------------------------------
 from pyhaskell.interpreter import module
 
+import sys
 
 mod = module.CoreMod("base:System.IO")
 
 
 @mod.expose("putStrLn", 1)
 def putStrLn(args):
-    print args[0].value
+
+    t = args[0]
+
+    while len(t.getargs()) > 1:
+        sys.stdout.write( t.getarg(0).getarg(0).value )
+        t = t.getarg(1)
+
+
     return args[0]

File pyhaskell/builtin/num.py

 
 mod = module.CoreMod("base:GHC.Num")
 mod.qvars["$fNumInt"] = Int(1)
-izh = types.mod.qdcons["I#"]
-
 
 @haskell.expose_primitive(1)
 def izhconstr(args):
     a, = args
-    return haskell.make_constructor(izh, [a])
+    assert isinstance(a, Int)
+    return haskell.constr("I#", a)
 
 
 # (-)
             [haskell.make_partial_app(prim.add, [a.getarg(0), b.getarg(0)])])
     else:
         raise NotImplementedError
+

File pyhaskell/builtin/prim.py

 
 mod.qdcons["Char#"] = haskell.Symbol("Char#")#CharConstr
 mod.qtycons["Char#"] = Unboxed
-#haskell.make_constructor(haskell.Symbol("GHC.Prim.Char#"), [])
 
 # TODO: Where do values belong????
 

File pyhaskell/builtin/show.py

 @mod.expose("$fShowInt", 1)
 def zdfShowInt(args):
     a, = args
-    return types.Addr(str(a.getarg(0).value))
+    s = str(a.getarg(0))
+
+    t = haskell.constr("[]")
+    for i in range(len(s)-1,-1,-1):
+        c = haskell.constr( "C#", types.Char(s[i]) )
+        t = haskell.constr(":", c, t)
+
+    return t

File pyhaskell/builtin/types.py

 
 # Type constructors
 #mod.qtycons["Bool"] = todo
-mod.qtycons["Char"] = haskell.make_constructor(haskell.Symbol("Char"), [])
-mod.qtycons["Int"] = haskell.Symbol("I#")
-mod.qtycons["Float"] = haskell.make_constructor(haskell.Symbol("Float"), [])
-mod.qtycons["Double"] = haskell.make_constructor(haskell.Symbol("Double"), [])
+mod.qtycons["Char"] = haskell.constr("Char")
+mod.qtycons["Float"] = haskell.constr("Float")
+mod.qtycons["Double"] = haskell.constr("Double")
 mod.qtycons["IO"] = haskell.Symbol("IO")
 
 
 # Value constructors
 mod.qdcons["True"] = types.true
 mod.qdcons["False"] = types.false
-mod.qdcons["I#"] = haskell.Symbol("I#")
 mod.qdcons["IO"] = haskell.Symbol("IO")
 
-mod.qdcons[":"] = haskell.Symbol(":")  # Not part of this module in GHC 7.4
-mod.qdcons["[]"] = haskell.Symbol("[]")  # Not part of this module in GHC 7.4
+
+# Int/I# Constructors
+izh_sym = haskell.Symbol("I#")
+mod.qdcons["I#"] = izh_sym
+mod.qtycons["Int"] = izh_sym
+
+
+# Append-head operator (“cons”)
+# Not part of this module in GHC 7.4
+cons_sym = haskell.Symbol(":")
+mod.qdcons[":"] = cons_sym
+mod.qtycons[":"] = cons_sym
+
+
+# List constructor
+# Not part of this module in GHC 7.4
+zmzn = haskell.constr("[]")
+mod.qdcons["[]"] = zmzn
+mod.qtycons["[]"] = zmzn
+
 
 # Data Char
 @haskell.expose_primitive(1)
 
 
 mod.qdcons["C#"] = Czh
+mod.qtycons["C#"] = Czh

File pyhaskell/interpreter/jscparser.py

             qty_mod, qty_name = self.get_module(node, 1, 1)
 
             ty = node.children[3].children[1].visit(self)
-            const = haskell.make_constructor(haskell.Symbol(qty_name), [ty])
+            const = haskell.constr(qty_name, ty)
             add_qtycon(mod, name, const)
             add_qtycon(qty_mod, qty_name, const)
 
             # SET RECURSIVE VARIABLE,
             # VISIT RECURSIVE VALUE DEFINITIONS
             self.current_rec = True
+            self.recursive.append(True)
             recs = self._visit_children(node, 0, 1)
-            self.current_rec = False
+            self.current_rec = self.recursive.pop()
             return recs[0]
 
         # Value definition
                 return exp
             else:
                 if isinstance(exp, haskell.Symbol):
-                    app = haskell.make_constructor(exp, [args])
+                    return haskell.constr(exp.str, args)
                 else:
-                    app = haskell.make_partial_app(exp, [args])
-            return app
+                    return haskell.make_partial_app(exp, [args])
 
         # Atomic expression
         elif type_ == "aexp" and len(node.children) == 1:
             qdcon = get_qdcon(*self.get_module(node, 0, 1))
             exp = node.children[3].children[1].visit(self)
 
-            dcon = haskell.make_constructor(qdcon, vbinds)
+            dcon = haskell.constr(qdcon.str, *vbinds)
             varlist = [dcon]
 
             return (varlist, exp)
 
 
 # Kinds
-lifted_kind = haskell.make_constructor(haskell.Symbol("*"), [])
-unlifted_kind = haskell.make_constructor(haskell.Symbol("#"), [])
-open_kind = haskell.make_constructor(haskell.Symbol("?"), [])
+lifted_kind = haskell.constr("*")
+unlifted_kind = haskell.constr("#")
+open_kind = haskell.constr("?")
 

File pyhaskell/interpreter/types.py

 class Addr(haskell.Value):
     _immutable_fields_ = ["value"]
 
-    def __init__(self, char):
-        self.value = char
+    def __init__(self, value):
+        self.value = value
 
     def tostr(self):
-        return self.value
+        return "Addr: " + str(self.value)
 
     def __str__(self):
         return self.tostr()

File pyhaskell/test/letrec/letrec.hs

 
-main = putStrLn $ show ones 
+main = putStrLn $ show ones
 
 ones :: [Int]
 ones = let p = 1:p