KevinMidboe/linguist
1
0
Fork 0
mirror of https://github.com/KevinMidboe/linguist.git synced 2025-10-28 17:20:22 +00:00
Code Issues Packages Projects Releases Wiki Activity

Added support for LFE (Lisp Flavored Erlang).

Browse Source
This commit is contained in:
Duncan McGreggor
2013-06-21 14:23:31 -07:00
parent 1e958a18f8
commit 479871f019
5 changed files with 474 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
lib/linguist/languages.yml
View File

@@ -680,6 +680,13 @@ Kotlin:
- .ktm
- .kts
LFE:
type: programming
primary_extension: .lfe
color: "#004200"
Lexer: Common Lisp
group: Erlang
LLVM:
primary_extension: .ll

111
samples/LFE/church.lfe Normal file
View File

@@ -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))

104
samples/LFE/gps1.lfe Normal file
View File

@@ -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))))

83
samples/LFE/mnesia_demo.lfe Normal file
View File

@@ -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)))

169
samples/LFE/object.lfe Normal file
View File

@@ -0,0 +1,169 @@
;; 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 : object.lfe
;; Author : Duncan McGreggor
;; Purpose : Demonstrating simple OOP with closures
;; The simple object system demonstrated below shows how to do the following:
;; * create objects
;; * call methods on those objects
;; * have methods which can call other methods
;; * update the state of an instance variable
;;
;; Note, however, that his example does not demonstrate inheritance.
;;
;; To use the code below in LFE, do the following:
;;
;; $ cd examples
;; $ ../bin/lfe -pa ../ebin
;;
;; Load the file and create a fish-class instance:
;;
;; > (slurp '"object.lfe")
;; #(ok object)
;; > (set mommy-fish (fish-class '"Carp"))
;; #Fun<lfe_eval.10.91765564>
;;
;; Execute some of the basic methods:
;;
;; > (get-species mommy-fish)
;; "Carp"
;; > (move mommy-fish 17)
;; The Carp swam 17 feet!
;; ok
;; > (get-id mommy-fish)
;; "47eebe91a648f042fc3fb278df663de5"
;;
;; Now let's look at "modifying" state data (e.g., children counts):
;;
;; > (get-children mommy-fish)
;; ()
;; > (get-children-count mommy-fish)
;; 0
;; > (set (mommy-fish baby-fish-1) (reproduce mommy-fish))
;; (#Fun<lfe_eval.10.91765564> #Fun<lfe_eval.10.91765564>)
;; > (get-id mommy-fish)
;; "47eebe91a648f042fc3fb278df663de5"
;; > (get-id baby-fish-1)
;; "fdcf35983bb496650e558a82e34c9935"
;; > (get-children-count mommy-fish)
;; 1
;; > (set (mommy-fish baby-fish-2) (reproduce mommy-fish))
;; (#Fun<lfe_eval.10.91765564> #Fun<lfe_eval.10.91765564>)
;; > (get-id mommy-fish)
;; "47eebe91a648f042fc3fb278df663de5"
;; > (get-id baby-fish-2)
;; "3e64e5c20fb742dd88dac1032749c2fd"
;; > (get-children-count mommy-fish)
;; 2
;; > (get-info mommy-fish)
;; id: "47eebe91a648f042fc3fb278df663de5"
;; species: "Carp"
;; children: ["fdcf35983bb496650e558a82e34c9935",
;; "3e64e5c20fb742dd88dac1032749c2fd"]
;; ok
(defmodule object
(export all))
(defun fish-class (species)
"
This is the constructor that will be used most often, only requiring that
one pass a 'species' string.
When the children are not defined, simply use an empty list.
"
(fish-class species ()))
(defun fish-class (species children)
"
This contructor is mostly useful as a way of abstracting out the id
generation from the larger constructor. Nothing else uses fish-class/2
besides fish-class/1, so it's not strictly necessary.
When the id isn't know, generate one."
(let* (((binary (id (size 128))) (: crypto rand_bytes 16))
(formatted-id (car
(: io_lib format
'"~32.16.0b" (list id)))))
(fish-class species children formatted-id)))
(defun fish-class (species children id)
"
This is the constructor used internally, once the children and fish id are
known.
"
(let ((move-verb '"swam"))
(lambda (method-name)
(case method-name
('id
(lambda (self) id))
('species
(lambda (self) species))
('children
(lambda (self) children))
('info
(lambda (self)
(: io format
'"id: ~p~nspecies: ~p~nchildren: ~p~n"
(list (get-id self)
(get-species self)
(get-children self)))))
('move
(lambda (self distance)
(: io format
'"The ~s ~s ~p feet!~n"
(list species move-verb distance))))
('reproduce
(lambda (self)
(let* ((child (fish-class species))
(child-id (get-id child))
(children-ids (: lists append
(list children (list child-id))))
(parent-id (get-id self))
(parent (fish-class species children-ids parent-id)))
(list parent child))))
('children-count
(lambda (self)
(: erlang length children)))))))
(defun get-method (object method-name)
"
This is a generic function, used to call into the given object (class
instance).
"
(funcall object method-name))
; define object methods
(defun get-id (object)
(funcall (get-method object 'id) object))
(defun get-species (object)
(funcall (get-method object 'species) object))
(defun get-info (object)
(funcall (get-method object 'info) object))
(defun move (object distance)
(funcall (get-method object 'move) object distance))
(defun reproduce (object)
(funcall (get-method object 'reproduce) object))
(defun get-children (object)
(funcall (get-method object 'children) object))
(defun get-children-count (object)
(funcall (get-method object 'children-count) object))