Permalink
Browse files

Added support for LFE (Lisp Flavored Erlang).

  • Loading branch information...
1 parent 1e958a1 commit 479871f0191fe6871e047eb0049237016465ffa4 Duncan McGreggor committed Jun 21, 2013
Showing with 474 additions and 0 deletions.
  1. +7 −0 lib/linguist/languages.yml
  2. +111 −0 samples/LFE/church.lfe
  3. +104 −0 samples/LFE/gps1.lfe
  4. +83 −0 samples/LFE/mnesia_demo.lfe
  5. +169 −0 samples/LFE/object.lfe
@@ -680,6 +680,13 @@ Kotlin:
- .ktm
- .kts
+LFE:
+ type: programming
+ primary_extension: .lfe
+ color: "#004200"
+ Lexer: Common Lisp
+ group: Erlang
+
LLVM:
primary_extension: .ll
View
@@ -0,0 +1,111 @@
+;; Copyright (c) 2013 Duncan McGreggor <oubiwann@cogitat.io>
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+
+;; File : church.lfe
+;; Author : Duncan McGreggor
+;; Purpose : Demonstrating church numerals from the lambda calculus
+
+;; The code below was used to create the section of the user guide here:
+;; http://lfe.github.io/user-guide/recursion/5.html
+;;
+;; Here is some example usage:
+;;
+;; > (slurp '"church.lfe")
+;; #(ok church)
+;; > (zero)
+;; #Fun<lfe_eval.10.53503600>
+;; > (church->int1 (zero))
+;; 0
+;; > (church->int1 (three))
+;; 3
+;; > (church->int1 (five))
+;; 5
+;; > (church->int2 #'five/0)
+;; 5
+;; > (church->int2 (lambda () (get-church 25)))
+;; 25
+
+(defmodule church
+ (export all))
+
+(defun zero ()
+ (lambda (s)
+ (lambda (x) x)))
+
+(defun one ()
+ (lambda (s)
+ (lambda (x)
+ (funcall s x))))
+
+(defun two ()
+ (lambda (s)
+ (lambda (x)
+ (funcall s
+ (funcall s x)))))
+
+(defun three ()
+ (lambda (s)
+ (lambda (x)
+ (funcall s
+ (funcall s
+ (funcall s x))))))
+
+(defun four ()
+ (lambda (s)
+ (lambda (x)
+ (funcall s
+ (funcall s
+ (funcall s
+ (funcall s x)))))))
+
+(defun five ()
+ (get-church 5))
+
+(defun int-successor (n)
+ (+ n 1))
+
+(defun church->int1 (church-numeral)
+ "
+ Converts a called church numeral to an integer, e.g.:
+ > (church->int1 (five))
+ "
+ (funcall
+ (funcall church-numeral #'int-successor/1) 0))
+
+(defun church->int2 (church-numeral)
+ "
+ Converts a non-called church numeral to an integer, e.g.:
+ > (church->int2 #'five/0)
+ "
+ (funcall
+ (funcall
+ (funcall church-numeral) #'int-successor/1) 0))
+
+(defun church-successor (church-numeral)
+ (lambda (s)
+ (lambda (x)
+ (funcall s
+ (funcall
+ (funcall church-numeral s) x)))))
+
+(defun get-church (church-numeral count limit)
+ (cond ((== count limit) church-numeral)
+ ((/= count limit)
+ (get-church
+ (church-successor church-numeral)
+ (+ 1 count)
+ limit))))
+
+(defun get-church (integer)
+ (get-church (zero) 0 integer))
View
@@ -0,0 +1,104 @@
+;;; -*- Mode: LFE; -*-
+;;; Code from Paradigms of Artificial Intelligence Programming
+;;; Copyright (c) 1991 Peter Norvig
+
+;;;; File gps1.lisp: First version of GPS (General Problem Solver)
+
+;;;; Converted to LFE by Robert Virding
+
+;; Define macros for global variable access. This is a hack and very naughty!
+(defsyntax defvar
+ ([name val] (let ((v val)) (put 'name v) v)))
+
+(defsyntax setvar
+ ([name val] (let ((v val)) (put 'name v) v)))
+
+(defsyntax getvar
+ ([name] (get 'name)))
+
+;; Module definition.
+
+(defmodule gps1
+ (export (gps 2) (gps 3) (school-ops 0))
+ (import (from lists (member 2) (all 2) (any 2))
+ ;; Rename lists functions to be more CL like.
+ (rename lists ((all 2) every) ((any 2) some) ((filter 2) find-all))))
+
+;; An operation.
+(defrecord op
+ action preconds add-list del-list)
+
+;; General Problem Solver: achieve all goals using *ops*.
+(defun gps (state goals ops)
+ ;; Set global variables
+ (defvar *state* state) ;The current state: a list of conditions.
+ (defvar *ops* ops) ;A list of available operators.
+ (if (every (fun achieve 1) goals) 'solved))
+
+(defun gps (state goals)
+ ;; Set global variables, but use existing *ops*
+ (defvar *state* state) ;The current state: a list of conditions.
+ (if (every (fun achieve 1) goals) 'solved))
+
+;; A goal is achieved if it already holds or if there is an
+;; appropriate op for it that is applicable."
+(defun achieve (goal)
+ (orelse (member goal (getvar *state*))
+ (some (fun apply-op 1)
+ (find-all (lambda (op) (appropriate-p goal op))
+ (getvar *ops*)))))
+
+;; An op is appropriate to a goal if it is in its add list.
+(defun appropriate-p (goal op)
+ (member goal (op-add-list op)))
+
+;; Print a message and update *state* if op is applicable.
+(defun apply-op (op)
+ (if (every (fun achieve 1) (op-preconds op))
+ (progn
+ (: io fwrite '"executing ~p\n" (list (op-action op)))
+ (setvar *state* (set-difference (getvar *state*) (op-del-list op)))
+ (setvar *state* (union (getvar *state*) (op-add-list op)))
+ 'true)))
+
+;; Define the set functions to work on list, a listsets module really.
+(defun set-difference
+ ([(cons e es) s2]
+ (if (member e s2)
+ (set-difference es s2)
+ (cons e (set-difference es s2))))
+ ([() s2] ()))
+
+(defun union
+ ([(cons e es) s2]
+ (if (member e s2) (union es s2) (cons e (union es s2))))
+ ([() s2] ()))
+
+;;; ==============================
+
+(defun school-ops ()
+ (list
+ (make-op action 'drive-son-to-school
+ preconds '(son-at-home car-works)
+ add-list '(son-at-school)
+ del-list '(son-at-home))
+ (make-op action 'shop-installs-battery
+ preconds '(car-needs-battery shop-knows-problem shop-has-money)
+ add-list '(car-works)
+ del-list ())
+ (make-op action 'tell-shop-problem
+ preconds '(in-communication-with-shop)
+ add-list '(shop-knows-problem)
+ del-list ())
+ (make-op action 'telephone-shop
+ preconds '(know-phone-number)
+ add-list '(in-communication-with-shop)
+ del-list ())
+ (make-op action 'look-up-number
+ preconds '(have-phone-book)
+ add-list '(know-phone-number)
+ del-list ())
+ (make-op action 'give-shop-money
+ preconds '(have-money)
+ add-list '(shop-has-money)
+ del-list '(have-money))))
@@ -0,0 +1,83 @@
+;; Copyright (c) 2008-2013 Robert Virding
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+
+;; File : mnesia_demo.lfe
+;; Author : Robert Virding
+;; Purpose : A simple Mnesia demo file for LFE.
+
+;; This file contains a simple demo of using LFE to access Mnesia
+;; tables. It shows how to use the emp-XXXX macro (ETS match pattern)
+;; together with mnesia:match_object, match specifications with
+;; mnesia:select and Query List Comprehensions.
+
+(defmodule mnesia_demo
+ (export (new 0) (by_place 1) (by_place_ms 1) (by_place_qlc 1)))
+
+(defrecord person name place job)
+
+(defun new ()
+ ;; Start mnesia and create a table, we will get an in memory only schema.
+ (: mnesia start)
+ (: mnesia create_table 'person '(#(attributes (name place job))))
+ ;; Initialise the table.
+ (let ((people '(
+ ;; First some people in London.
+ #(fred london waiter)
+ #(bert london waiter)
+ #(john london painter)
+ #(paul london driver)
+ ;; Now some in Paris.
+ #(jean paris waiter)
+ #(gerard paris driver)
+ #(claude paris painter)
+ #(yves paris waiter)
+ ;; And some in Rome.
+ #(roberto rome waiter)
+ #(guiseppe rome driver)
+ #(paulo rome painter)
+ ;; And some in Berlin.
+ #(fritz berlin painter)
+ #(kurt berlin driver)
+ #(hans berlin waiter)
+ #(franz berlin waiter)
+ )))
+ (: lists foreach (match-lambda
+ ([(tuple n p j)]
+ (: mnesia transaction
+ (lambda ()
+ (let ((new (make-person name n place p job j)))
+ (: mnesia write new))))))
+ people)))
+
+;; Match records by place using match_object and the emp-XXXX macro.
+(defun by_place (place)
+ (: mnesia transaction
+ (lambda () (: mnesia match_object (emp-person place place)))))
+
+;; Use match specifications to match records
+(defun by_place_ms (place)
+ (let ((f (lambda () (: mnesia select 'person
+ (match-spec ([(match-person name n place p job j)]
+ (when (=:= p place))
+ (tuple n j)))))))
+ (: mnesia transaction f)))
+
+;; Use Query List Comprehensions to match records
+(defun by_place_qlc (place)
+ (let ((f (lambda ()
+ (let ((q (qlc (lc ((<- person (: mnesia table 'person))
+ (=:= (person-place person) place))
+ person))))
+ (: qlc e q)))))
+ (: mnesia transaction f)))
Oops, something went wrong.

0 comments on commit 479871f

Please sign in to comment.