Talk:Anemone

From Esolang
(Redirected from Talk:Defcalc)
Jump to navigation Jump to search

An implementation of Defcalc

Notes

Given:

and t t = t.
and X Y = f.

results in

and (and t t) t => f

My initial interpretation of "the outer-most reducible term" results in different semantics than what the fibonacci example implies. Changing search in my implementation from breadth-first to depth-first allows it to match the fibonacci example.

(I think the "outer-most reducible term" thing just means you have to evaluate the operands before the function. --Koen (talk) 02:32, 20 September 2012 (UTC)
That's pretty much the opposite of the usual technical meaning. --Ørjan (talk) 03:01, 20 September 2012 (UTC))

Breadth-first:

and (cons (and t t) (and t t)) (and t t)
and (cons (and t t) (and t t)) t
and (cons t (and t t)) t
and (cons t t) t

Depth-first:

and (cons (and t t) (and t t)) (and t t)
and (cons t (and t t)) (and t t)
and (cons t t) (and t t)
and (cons t t) t

Code

module Main(main) where

import System.Environment(getArgs)
import Text.ParserCombinators.Parsec(Parser,char,many,many1,noneOf,oneOf,parse,spaces,(<|>))

main :: IO ()
main = do
   (src:_) <- getArgs
   fmap (rules src) (readFile src) >>= either putStrLn (interact . repl)

repl :: [Rule] -> String -> String
repl rules input = unlines (map (unlines . eval rules) (lines input))

eval :: [Rule] -> String -> [String]
eval rules input =
   either (:[]) (map show . apply rules) (terms "(input)" input)

-- Expr

data Expr = Expr [Expr] | Atom String | Variable String deriving Eq

data Rule = Rule Expr Expr

canonical :: Expr -> Expr
canonical (Expr [expr]) = canonical expr
canonical (Expr ((Expr expr):exprs)) = canonical (Expr (expr ++ exprs))
canonical (Expr exprs) = Expr (map canonical exprs)
canonical expr = expr

instance Show Expr where
   showsPrec prec (Expr expr) =
       showParen (prec > 0) (unwords (map (flip (showsPrec 1) "") expr) ++)
   showsPrec _ (Atom atom) = showString atom
   showsPrec _ (Variable variable) = showString variable

instance Show Rule where
   showsPrec _ (Rule lhs rhs) =
       shows lhs . showString " = " . shows rhs . showChar '.'

-- Rules

data ResultTree a = NoResult | Result a | DeeperResult [ResultTree a]

instance Functor ResultTree where
   fmap _ NoResult = NoResult
   fmap f (Result a) = Result (f a)
   fmap f (DeeperResult as) = DeeperResult (map (fmap f) as)

search :: ResultTree a -> Maybe a
search NoResult = Nothing
search (Result a) = Just a
search (DeeperResult as) =
   let search' [] = Nothing
       search' (NoResult:as') = search' as'
       search' ((Result a):_) = Just a
       search' ((DeeperResult deeper):as') = search' (as' ++ deeper)
       -- for depth-first search, replace the preceding 3 lines with:
       -- search' (a:as) = maybe (search' as) Just (search a)
   in  search' as

apply :: [Rule] -> Expr -> [Expr]
apply rules expr =
   maybe [] (\ exp' -> exp' : apply rules exp') (search (apply1 rules expr))

apply1 :: [Rule] -> Expr -> ResultTree Expr
apply1 rules expr =
   maybe (applySubexprs rules expr) (Result . canonical) (applyTop rules expr)

applySubexprs :: [Rule] -> Expr -> ResultTree Expr
applySubexprs rules (Expr exprs) =
   let applyEach _ [] = []
       applyEach pre (expr:exprs) =
           fmap (Expr . (reverse pre ++) . (:exprs)) (apply1 rules expr)
               : applyEach (expr:pre) exprs
   in  DeeperResult (applyEach [] exprs)
applySubexprs rules _ = NoResult

applyTop :: [Rule] -> Expr -> Maybe Expr
applyTop [] _ = Nothing
applyTop ((Rule pattern replacement):rules) expr =
   maybe (applyTop rules expr)
         (Just . replace replacement)
         (match True pattern expr [])

match :: Bool -> Expr -> Expr -> [(String,Expr)] -> Maybe [(String,Expr)]
match top (Expr pattern) (Expr terms) bindings =
   match' top pattern terms bindings
match top (Variable variable) term bindings =
   maybe (Just ((variable,term):bindings))
         (\ value -> if value == term then Just bindings else Nothing)
         (lookup variable bindings)
match _ pattern term bindings =
   if pattern == term then Just bindings else Nothing

match' :: Bool -> [Expr] -> [Expr] -> [(String,Expr)] -> Maybe [(String,Expr)]
match' top (pattern:patterns) (term:terms) bindings =
   maybe Nothing (match' top patterns terms)
         (match False pattern term bindings)
match' _ [] [] bindings = Just bindings
match' True [] terms bindings = Just (("",Expr terms):bindings)
match' _ _ _ _ = Nothing

replace :: Expr -> [(String,Expr)] -> Expr
replace expr bindings =
   maybe (substitute bindings expr)
         (appendExpr (substitute bindings expr))
         (lookup "" bindings)

substitute :: [(String,Expr)] -> Expr -> Expr
substitute _ expr@(Atom _) = expr
substitute bindings (Variable variable) =
   maybe (error ("unbound variable: " ++ variable)) id
         (lookup variable bindings)
substitute bindings (Expr exprs) =
   Expr (map (substitute bindings) exprs)

appendExpr :: Expr -> Expr -> Expr
appendExpr (Expr exprs1) (Expr exprs2) = Expr (exprs1 ++ exprs2)
appendExpr (Expr exprs1) expr2 = Expr (exprs1 ++ [expr2])
appendExpr expr1 (Expr exprs2) = Expr (expr1 : exprs2)
appendExpr expr1 expr2 = Expr [expr1, expr2]

-- Parser

f <$> a = fmap f a
f <*> a = f >>= (<$> a)
a *>  b = a >> b
a <*  b = const <$> a <*> b
infixl 4 <$>
infixl 4 <*>
infixl 4 *>
infixl 4 <*

ch :: Char -> Parser Char
ch c = char c <* spaces

atom :: Parser Expr
atom = Atom <$> ((:) <$> noneOf (" \t\r\n.=()" ++ ['A'..'Z'])
                     <*> many (noneOf " \t\r\n.=()")
                     <* spaces)

variable :: Parser Expr
variable = Variable <$> ((:) <$> oneOf ['A'..'Z']
                             <*> many (noneOf " \t\r\n.=()")
                             <* spaces)

rule :: Parser Rule
rule = Rule <$> ((canonical . Expr) <$> many1 expr) <* ch '='
            <*> ((canonical . Expr) <$> many1 expr) <* ch '.'

expr :: Parser Expr
expr = Expr <$> (ch '(' *> many1 expr <* ch ')') <|> atom <|> variable

rules :: String -> String -> Either String [Rule]
rules source contents =
   either (Left . show) Right (parse (spaces *> many1 rule) source contents)

term :: Parser Expr
term = Expr <$> (ch '(' *> many1 term <* ch ')') <|> atom

terms :: String -> String -> Either String Expr
terms source contents =
   either (Left . show) (Right . canonical . Expr)
          (parse (spaces *> many1 term) source contents)

--Qpliu 02:08, 4 February 2010 (UTC)

Thanks for the great feedback. That AND did need to be changed--though I needed a simple way to explain that order of rules is important. I've now used the "equals" predicate for this purpose.
Breadth-first is correct. However, my Fibonacci example was not correct, simply because of my carelessness in evaluating the examples manually, as I had not yet written an interpreter. Now that there is one, that problem is solved, though I am experiencing some difficulties with the interpreter, namely that SKI combinator logic does not work as it should.
Once again, thanks! --Afarnen 09:03, 6 February 2010 (UTC)
Yeah, there's a bug in the code. I think it should be fixed now.
The eq example also has non-intuitive results, for example
eq (eq eq eq) t => f
--Qpliu 05:11, 7 February 2010 (UTC)
You would expect those kind of results when you don't have types. I left algebraic data types out of the wiki, as I'm not sure how exactly I would implement them. I might do, for example, Boolean algebra like this:
bool (not (bool t)) = bool f.
bool (not (bool f)) = bool t.
bool (and (bool t) (bool X)) = bool X.
bool (and (bool f) (bool X)) = bool f.
bool (or (bool t) (bool X)) = bool t.
bool (or (bool f) (bool X)) = bool X.
wrapping all data with "type" atoms. A test run:
bool (and (bool t) (bool (or (bool (not (bool f))) (bool f))))
bool (or (bool (not (bool f))) (bool f))
bool (or (bool t) (bool f))
bool t
However, this prevents Currying with "wrapped" terms. A better way might be (note the use of "typed" SKI combinators):
X i (X Y) = X Y.
X k (X Y) (X Z) = X Y.
bool not (bool t) = bool f.
bool not (bool f) = bool t.
bool and (bool t) = bool i.
bool and (bool f) = bool k (bool f).
bool or (bool t) = bool k (bool t).
bool or (bool f) = bool i.
It may be to your surprise, as I haven't made it clear before, but those first two rules are perfectly valid--though your interpreter doesn't like them. The same expression, with this new type encoding:
bool and (bool t) (bool or (bool not (bool f)) (bool f))
bool i (bool or (bool not (bool f)) (bool f))
bool or (bool not (bool f)) (bool f)
bool or (bool t) (bool f)
bool k (bool t) (bool f)
bool t
I'm going to explore this concept further. The language itself is completely finished, but at the moment I haven't written any formal or complete documentation because I'm not sure how one would use it practically. --Afarnen 09:46, 7 February 2010 (UTC)
P.S. The code works great! --Afarnen 09:48, 7 February 2010 (UTC)
Disallowing rules starting with variables actually made the parser slightly more complicated. --Qpliu 01:55, 11 February 2010 (UTC)

A second, complete interpreter

Here's my interpreter that I wrote in Python (it's a little long, since I wrote the parser from scratch, and it catches all syntax errors). It even allows rules that start with variables. It's poorly documented at the moment:

#! /usr/bin/python

"""

Defcalc interpreter v0.1 by Andrew Farnen

Usage:

defcalc.py [input-file-0] [input-file-1] [input-file-2] ...

"""

# for reading input files
import sys

# for breadth-first search
from collections import deque

 # tokens

class token:
  def __init__(self, name, line, col):
    self.name = name
    self.line = line
    self.col = col
  def __str__(self):
    return self.name

class l_paren(token):
  pass

class r_paren(token):
  pass

class equals(token):
  pass

class period(token):
  pass

class string(token):
  pass

class eof(token):
  pass

# syntax

class atom:
  def __init__(self, name):
    self.name = name
  def __str__(self, outer):
    return self.name

class var:
  def __init__(self, name):
    self.name = name
  def __str__(self, outer):
    return self.name

class app:
  def __init__(self, left, right):
    self.left = left
    self.right = right
  def __str__(self, outer):
    ret = 
    if outer == 0:
      ret = '('
    
    ret += self.left.__str__(isinstance(self.left, app)) + ' ' + self.right.__str__(0)
    
    if outer == 0:
      ret += ')'
    return ret

class rule:
  def __init__(self, left, right):
    self.left = left
    self.right = right
  def __str__(self):
    return self.left.__str__(1) + ' = ' + self.right.__str__(1) + '. '

class syntax_error(Exception):
  def __init__(self, message):
    self.message = message

class empty(Exception):
  pass

# tokenize string, returning list of tokens

def tokenize(s):
  tokens = []
  line = 0
  col = 0
  pos = 0
  strflag = 0
  
  for pos, char in enumerate(s):
    if char == '\n':
      line += 1
    
    if strflag == 1:
      if char.isspace() or char in '()=.':
        tokens.append(string(s[start:pos], line, startcol))
        strflag = 0
    
    if strflag == 0:
      if not char.isspace():
        if char == '(':
          tokens.append(l_paren('(', line, col))
        elif char == ')':
          tokens.append(r_paren(')', line, col))
        elif char == '=':
          tokens.append(equals('=', line, col))
        elif char == '.':
          tokens.append(period('.', line, col))
        else:
          strflag = 1
          start = pos
          startcol = col
    
    if char == '\n':
      col = 0
    else:
      col += 1
  
  if strflag == 1:
    tokens.append(string(s[start:], line, start))
 
  tokens.append(eof(, line, col))
  
  return tokens

# parse term from list of tokens, returning either atom, var or app

def parse(tokens, start, end, accept_vars, filename):
  if start == end:
    raise empty()
  
  if isinstance(tokens[end], l_paren) or isinstance(tokens[end], equals) or isinstance(tokens[end], period):
    raise syntax_error("Syntax error (" + filename + ", line " + str(tokens[end].line) + ", col " + str(tokens[end].col) + "): unexpected `" + tokens[end].name + "'")
  
  if isinstance(tokens[end], string):
    if tokens[end].name[0].isupper():
      if accept_vars == 0:
        raise syntax_error("Syntax error (" + filename + ", line " + str(tokens[end].line) + ", col " + str(tokens[end].col) + "): unexpected var `" + tokens[end].name + "'")
      right = var(tokens[end].name)
    else:
      right = atom(tokens[end].name)
    
    right_empty = 0
    pos = end - 1
  
  elif isinstance(tokens[end], r_paren):
    
    right_empty = 1
    depth = 1
    pos = end - 1
    token = tokens[pos]
    
    while pos > start and depth > 0:
      if isinstance(token, r_paren):
        depth += 1
      elif isinstance(token, l_paren):
        depth -= 1
        if depth < 0:
          raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unmatched parentheses")
      elif isinstance(token, equals) or isinstance(token, period):
        raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unexpected `" + token.name + "'")
      elif isinstance(token, string):
        right_empty = 0
      
      pos -= 1
      token = tokens[pos]
    
    if depth > 0:
      raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unmatched parentheses")
    
    if not right_empty:
      right = parse(tokens, pos + 1, end - 1, accept_vars, filename)
  
  if pos == start:
    if right_empty:
      raise empty()
    return right
  
  left_empty = 1
  depth = 0
  left_end = pos
  token = tokens[pos]
  
  while pos > start:
    if isinstance(token, r_paren):
      depth += 1
    elif isinstance(token, l_paren):
      depth -= 1
      if depth < 0:
        raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unmatched parentheses")
    elif isinstance(token, equals) or isinstance(token, period):
      raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unexpected `" + token.name + "'")
    elif isinstance(token, string):
      left_empty = 0
    
    pos -= 1
    token = tokens[pos]
  
  if depth > 0:
    raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unmatched parentheses")
  
  if not left_empty:
    left = parse(tokens, start, left_end, accept_vars, filename)
  
  if left_empty:
    if right_empty:
      raise empty()
    return right
  if right_empty:
    return left
  return app(left, right)

# parse rules from list of tokens, returning list of rules

def parse_rules(tokens, filename):
  rules = []
  
  start = 0
  mode = 0
  
  for pos, token in enumerate(tokens):
    
    if mode == 0:
      if isinstance(token, eof):
        if pos != start:
          raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unexpected end of input")
        break
      if isinstance(token, period):
        raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unexpected `" + token.name + "'")
      if isinstance(token, equals):
        if pos == start:
          raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): left-hand side of rule is empty")
        mode = 1
        split = pos + 1
  
    elif mode == 1:
      if isinstance(token, eof):
        raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unexpected end of input")
      if isinstance(token, equals):
        raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): unexpected `" + token.name + "'")
      if isinstance(token, period):
        if pos == split:
          raise syntax_error("Syntax error (" + filename + ", line " + str(token.line) + ", col " + str(token.col) + "): right-hand side of rule is empty")
        mode = 0
        rules.append(rule(parse(tokens, start - 1, split - 2, 1, filename), parse(tokens, split - 1, pos - 1, 1, filename)))
        start = pos + 1
  
  return rules

def matches(lhs, term, replace_dict):
  if isinstance(lhs, atom):
    if not isinstance(term, atom) or lhs.name != term.name:
      return 0, {}
    return 1, replace_dict
  if isinstance(lhs, var):
    if lhs.name in replace_dict:
      m = matches(replace_dict[lhs.name], term, {})
      if m[0] == 0:
        return 0, {}
      return 1, replace_dict
    replace_dict[lhs.name] = term
    return 1, replace_dict
  if isinstance(lhs, app):
    if not isinstance(term, app):
      return 0, {}
    m, replace_dict = matches(lhs.left, term.left, replace_dict)
    if m == 0:
      return 0, {}
    m, replace_dict = matches(lhs.right, term.right, replace_dict)
    if m == 0:
      return 0, {}
    return m, replace_dict

def replace(term, replace_dict):
  if isinstance(term, atom):
    return term
  if isinstance(term, var):
    if term.name not in replace_dict:
       return term
    return replace_dict[term.name]
  if isinstance(term, app):
    return app(replace(term.left, replace_dict), replace(term.right, replace_dict))

queue = deque([])

def reduce():
  global queue
  while 1:
    parent, term, side = queue.popleft()
    
    rule_num = 0
    while rule_num < len(rules):
      rule = rules[rule_num]
      
      match, replace_dict = matches(rule.left, term, {})
      
      if match:
        if side == 0:
          parent.left = replace(rule.right, replace_dict)
        else:
          parent.right = replace(rule.right, replace_dict)
        return 1
      
      rule_num += 1
    
    if isinstance(term, app):
      queue.append((term, term.left, 0))
      queue.append((term, term.right, 1))
    
    if len(queue) == 0:
      return 0

rules = []

for arg in sys.argv[1:]:
  input_file = open(arg, 'r')
  
  filename = input_file.name
  program = input_file.read()
  
  input_file.close()
  
  tokens = tokenize(program)
  
  try:
    parsed = parse_rules(tokens, filename)
    rules += parsed
    
  except syntax_error as e:
    print e.message

#for rule in rules:
#  print rule

while 1:
  term = raw_input(">>> ")
  
  tokens = tokenize(term)
  
  try:
    term = parse(tokens, -1, len(tokens) - 2, 0, 'stdin')
    print term.__str__(1)
    
    while 1:
      
      fake_app = app(term, None)
      
      queue = deque([(fake_app, term, 0)])
      
      if (reduce() == 0):
        break
      
      term = fake_app.left
      print term.__str__(1)
    
  except syntax_error as e:
    print e.message
  except empty:
    pass

--Afarnen 18:48, 7 February 2010 (UTC)